fs_selfservice/FS-SelfService/freeside-selfservice-clientd

   1 #!/usr/bin/perl -w
   2 #
   3 # freeside-selfservice-clientd
   4 #
   5 # This is run REMOTELY over ssh by freeside-selfservice-server
   6
   7 use strict;
   8 use subs qw(spawn logmsg);
   9 use Fcntl qw(:flock);
  10 use POSIX qw(:sys_wait_h);
  11 use Socket;
  12 use Storable qw(nstore_fd fd_retrieve);
  13 use IO::Handle qw(_IONBF);
  14 use IO::Select;
  15 use IO::File;
  16
  17 STDOUT->setbuf('');
  18
  19 use vars qw( $Debug );
  20 $Debug = 3; #2 will turn on child logging, 3 will log packet contents,
  21             #including potentially compromising information
  22
  23 my $socket = "/usr/local/freeside/selfservice_socket";
  24 my $pid_file = "$socket.pid";
  25
  26 my $log_file = "/usr/local/freeside/selfservice.log";
  27
  28 #my $me = '[client]';
  29
  30 $|=1;
  31
  32 $SIG{__WARN__} = \&_logmsg;
  33
  34 #read data to be cached or something
  35 #warn "$me Reading init data\n" if $Debug;
  36 #my $signup_init =
  37
  38 warn "Creating $socket\n" if $Debug;
  39 my $uaddr = sockaddr_un($socket);
  40 my $proto = getprotobyname('tcp');
  41 socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
  42 unlink($socket);
  43 bind(Server, $uaddr) or die "bind: $!";
  44 listen(Server,SOMAXCONN) or die "listen: $!";
  45
  46 if ( -e $pid_file ) {
  47   open(PIDFILE,"<$pid_file");
  48   my $old_pid = <PIDFILE>;
  49   close PIDFILE;
  50   $old_pid =~ /^(\d+)$/;
  51   kill 'TERM', $1;
  52 }
  53 open(PIDFILE,">$pid_file");
  54 print PIDFILE "$$\n";
  55 close PIDFILE;
  56
  57 #my $waitedpid;
  58 #sub REAPER { $waitedpid = wait; $SIG{CHLD} = \&REAPER; }
  59 #$SIG{CHLD} =  \&REAPER;
  60
  61 warn "entering main loop\n" if $Debug;
  62
  63 my %kids;
  64
  65 my $s = new IO::Select;
  66 $s->add(\*STDIN);
  67 $s->add(\*Server);
  68
  69 #for ( $waitedpid = 0;
  70 #      accept(Client,Server) || $waitedpid;
  71 #      $waitedpid = 0, close Client)
  72 #{
  73 #  next if $waitedpid;
  74
  75 #$SIG{PIPE} = sub { warn "SIGPIPE received" };
  76 #$SIG{CHLD} = sub { warn "SIGCHLD received" };
  77
  78 #sub REAPER { warn "SIGCHLD received"; my $pid = wait; $SIG{CHLD} = \&REAPER; }
  79 #sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; }
  80 #sub REAPER { my $pid = wait; delete $kids{$pid}; $SIG{CHLD} = \&REAPER; }
  81 #$SIG{CHLD} =  \&REAPER;
  82
  83 my $undisp = 0;
  84 while (1) {
  85
  86   &reap_kids;
  87
  88   warn "waiting for connection\n" if $Debug && !$undisp;
  89
  90   #my @handles = $s->can_read();
  91   my @handles = $s->can_read(5);
  92   $undisp = !scalar(@handles);
  93   foreach my $handle ( @handles ) {
  94
  95     if ( $handle == \*STDIN ) {
  96
  97       warn "receiving packet from server\n" if $Debug;
  98
  99       my $packet = fd_retrieve(\*STDIN);
 100       my $token = $packet->{'_token'};
 101       warn "received packet from server with token $token\n".
 102            ( $Debug > 2
 103              ? join('', map { " $_=>$packet->{$_}\n" } keys %$packet )
 104              : '' )
 105         if $Debug;
 106
 107      if ( exists($kids{$token}) ) {
 108         warn "sending return packet to $token via $kids{$token}\n"
 109           if $Debug;
 110         nstore_fd($packet, $kids{$token});
 111         warn "flushing to $token\n" if $Debug;
 112         until ( $kids{$token}->flush ) {
 113           warn "WARNING: error flushing: $!";
 114           sleep 1;
 115         }
 116         #no close or delete here - will block waiting for child
 117         warn "done with $token\n" if $Debug;
 118       } else {
 119         warn "WARNING: unknown token $token, discarding message";
 120       }
 121
 122     } elsif ( $handle == \*Server ) {
 123
 124       until ( accept(Client, Server) ) {
 125         warn "WARNING: accept failed: $!";
 126         next;
 127       }
 128
 129       warn "received local connection; forking\n" if $Debug;
 130
 131       spawn sub { #child
 132         warn "[child-$$] reading packet from local client" if $Debug > 1;
 133         my $packet = fd_retrieve(\*Client);
 134         warn "[child-$$] packet received:\n".
 135              join('', map { " $_=>$packet->{$_}\n" } keys %$packet )
 136           if $Debug > 2;
 137         my $command = $packet->{'command'};
 138         #handle some commands weirdly?
 139         $packet->{_token}=$$;
 140
 141         warn "[child-$$] sending packet to remote server" if $Debug > 1;
 142         flock(STDOUT, LOCK_EX) or die "FATAL: can't lock write stream: $!";
 143         nstore_fd($packet, \*STDOUT) or die "FATAL: can't send response: $!";
 144         STDOUT->flush or die "FATAL: can't flush: $!";
 145         flock(STDOUT, LOCK_UN) or die "FATAL: can't release write lock: $!";
 146         close STDOUT or die "FATAL: can't close write stream: $!"; #??!
 147
 148         warn "[child-$$] waiting for response from parent" if $Debug > 1;
 149         my $w = new IO::Select;
 150         $w->add(\*STDIN);
 151         until ( $w->can_read ) {
 152           warn "[child-$$] WARNING: interrupted select: $!\n";
 153         }
 154         my $rv = fd_retrieve(\*STDIN);
 155
 156         #close STDIN;
 157
 158         warn "[child-$$] sending response to local client" if $Debug > 1;
 159         nstore_fd($rv, \*Client);
 160         Client->flush or die "FATAL: can't flush to local client: $!";
 161         close Client or die "FATAL: can't close connection to local client: $!";
 162
 163         warn "[child-$$] child exiting" if $Debug > 1;
 164         exit;
 165
 166       }; #eo child
 167
 168       #close Client;
 169
 170     } else {
 171       die "wtf?  $handle";
 172     }
 173
 174   }
 175
 176 }
 177
 178 sub reap_kids {
 179   #warn "reaping kids\n";
 180   foreach my $pid ( keys %kids ) {
 181     my $kid = waitpid($pid, WNOHANG);
 182     if ( $kid > 0 ) {
 183       close $kids{$kid};
 184       delete $kids{$kid};
 185     }
 186   }
 187   #warn "done reaping\n";
 188 }
 189
 190 sub spawn {
 191     my $coderef = shift;
 192
 193     unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
 194         use Carp;
 195         confess "usage: spawn CODEREF";
 196     }
 197
 198     my $pid;
 199     #if (!defined($pid = fork)) {
 200     my $kid = new IO::Handle;
 201     if (!defined($pid = open($kid, '|-'))) {
 202         warn "WARNING: cannot fork: $!";
 203         return;
 204     } elsif ($pid) {
 205         warn "begat $pid" if $Debug;
 206         $kids{$pid} = $kid;
 207         #$kids{$pid}->autoflush;
 208         return; # I'm the parent
 209     }
 210     # else I'm the child -- go spawn
 211
 212 #    open(STDIN,  "<&Client")   || die "can't dup client to stdin";
 213 #    open(STDOUT, ">&Client")   || die "can't dup client to stdout";
 214 #     open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
 215     exit &$coderef();
 216 }
 217
 218 sub _logmsg {
 219   chomp( my $msg = shift );
 220   my $log = new IO::File ">>$log_file";
 221   flock($log, LOCK_EX);
 222   seek($log, 0, 2);
 223   print $log "[client] [". scalar(localtime). "] [$$] $msg\n";
 224   flock($log, LOCK_UN);
 225   close $log;
 226 }