RT# 81961 Repair broken links in POD documentation
[freeside.git] / fs_selfservice / FS-SelfService / freeside-selfservice-xmlrpc-server
1 #!/usr/bin/perl -w
2
3 =head1 NAME
4
5 freeside-selfservice-xmlrpc-server
6
7 =cut
8
9 use strict;
10 use Fcntl qw(:flock);
11 use POSIX;
12 use Getopt::Std;
13 use XMLRPC::Transport::HTTP;
14 use XMLRPC::Lite; # for XMLRPC::Serializer;
15 use FS::SelfService::XMLRPC;
16
17 use vars qw( $opt_p $opt_d );
18 use vars qw( $DEBUG );
19
20 getopts("p:d");
21 $DEBUG = $opt_d;
22 my $tag = $opt_p ? ':'.$opt_p : '';
23
24 my %typelookup = (
25   base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'],
26   dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'],
27   string => [40, sub {1}, 'as_string'],
28 );
29 my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup);
30
31 my $log_file = "/usr/local/freeside/selfservice.xmlrpc$tag.log";
32
33 my $pid = fork;
34 defined($pid) or die "Can't fork to start: $!";
35 print "Started daemon with pid $pid\n" if $pid;
36 exit if $pid;
37
38 POSIX::setsid();
39 open STDIN, "/dev/null" or die "Can't get rid of STDIN";
40 open STDOUT, ">/dev/null" or die "Can't get rid of STDOUT";
41 open STDERR, ">&STDOUT" or die "Can't get rid of STDERR";
42
43 $SIG{__WARN__} = \&_logmsg;
44 $SIG{__DIE__} = sub { &_logmsg(@_); exit };
45
46 my $daemon = XMLRPC::Transport::HTTP::Daemon
47   ->new(LocalPort => $opt_p ? $opt_p : 8080)
48   ->dispatch_to('FS::SelfService::XMLRPC')
49   ->serializer($serializer);
50
51 warn "Handling request at ", $daemon->url, "\n";
52 $daemon->handle;
53
54 sub _logmsg {
55   chomp( my $msg = shift );
56   my $log = new IO::File ">>$log_file";
57   flock($log, LOCK_EX);
58   seek($log, 0, 2);
59   print $log "[". scalar(localtime). "] [$$] $msg\n";
60   flock($log, LOCK_UN);
61   close $log;
62 }