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