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