From b58821fcd50e52ae726834ef3863b85ed293379f Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 11 Jul 2002 13:52:39 +0000 Subject: [PATCH] finally working async framework --- fs_selfservice/DEPLOY | 8 + fs_selfservice/FS-SelfService/MANIFEST | 2 +- fs_selfservice/FS-SelfService/SelfService.pm | 103 ++++++---- .../FS-SelfService/freeside-selfservice-clientd | 222 +++++++++++++++++++++ fs_selfservice/freeside-selfservice-server | 115 +++++++++-- fs_selfservice/fs_passwd_test | 14 ++ 6 files changed, 409 insertions(+), 55 deletions(-) create mode 100755 fs_selfservice/DEPLOY create mode 100644 fs_selfservice/FS-SelfService/freeside-selfservice-clientd create mode 100755 fs_selfservice/fs_passwd_test diff --git a/fs_selfservice/DEPLOY b/fs_selfservice/DEPLOY new file mode 100755 index 000000000..9b03bf259 --- /dev/null +++ b/fs_selfservice/DEPLOY @@ -0,0 +1,8 @@ +#!/bin/sh + +cd FS-SelfService +perl Makefile.PL && make && make install + +cd .. +kill `cat /var/run/freeside-selfservice-server.ivan.pid`; sleep 3 +./freeside-selfservice-server ivan localhost diff --git a/fs_selfservice/FS-SelfService/MANIFEST b/fs_selfservice/FS-SelfService/MANIFEST index 3c490e7dd..ebd0d3b1a 100644 --- a/fs_selfservice/FS-SelfService/MANIFEST +++ b/fs_selfservice/FS-SelfService/MANIFEST @@ -1,6 +1,6 @@ Changes Makefile.PL MANIFEST -README SelfService.pm test.pl +freeside-selfservice-clientd diff --git a/fs_selfservice/FS-SelfService/SelfService.pm b/fs_selfservice/FS-SelfService/SelfService.pm index 75e550a2d..3cd4fd94e 100644 --- a/fs_selfservice/FS-SelfService/SelfService.pm +++ b/fs_selfservice/FS-SelfService/SelfService.pm @@ -1,66 +1,95 @@ package FS::SelfService; -use 5.006; use strict; -use warnings; +use vars qw($VERSION @ISA @EXPORT_OK $socket); +use Exporter; +use Socket; +use FileHandle; +#use IO::Handle; +use IO::Select; +use Storable qw(nstore_fd fd_retrieve); -require Exporter; +$VERSION = '0.03'; -our @ISA = qw(Exporter); +@ISA = qw( Exporter ); +@EXPORT_OK = qw( passwd ); -# Items to export into callers namespace by default. Note: do not export -# names by default without a very good reason. Use EXPORT_OK instead. -# Do not simply export all your public functions/methods/constants. +$socket = "/usr/local/freeside/selfservice_socket"; -# This allows declaration use FS::SelfService ':all'; -# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK -# will save memory. -our %EXPORT_TAGS = ( 'all' => [ qw( - -) ] ); +$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin'; +$ENV{'SHELL'} = '/bin/sh'; +$ENV{'IFS'} = " \t\n"; +$ENV{'CDPATH'} = ''; +$ENV{'ENV'} = ''; +$ENV{'BASH_ENV'} = ''; -our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); +my $freeside_uid = scalar(getpwnam('freeside')); +die "not running as the freeside user\n" if $> != $freeside_uid; -our @EXPORT = qw( - -); -our $VERSION = '0.01'; +=head1 NAME +FS::SelfService - Freeside self-service API -# Preloaded methods go here. +=head1 SYNOPSIS -1; -__END__ -# Below is stub documentation for your module. You better edit it! +=head1 DESCRIPTION -=head1 NAME +Use this API to implement your own client "self-service" module. -FS::SelfService - Perl extension for blah blah blah +If you just want to customize the look of the existing "self-service" module, +see XXXX instead. -=head1 SYNOPSIS +=head1 FUNCTIONS - use FS::SelfService; - blah blah blah +=over 4 -=head1 DESCRIPTION +=item passwd -Stub documentation for FS::SelfService, created by h2xs. It looks like the -author of the extension was negligent enough to leave the stub -unedited. +Returns the empty value on success, or an error message on errors. -Blah blah blah. +=cut -=head2 EXPORT +sub passwd { + my $param; + if ( ref($_[0]) ) { + $param = shift; + } else { + $param = { @_ }; + } -None by default. + $param->{_packet} = 'passwd'; + simple_packet($param); +} -=head1 AUTHOR +sub simple_packet { + my $packet = shift; + socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + connect(SOCK, sockaddr_un($socket)) or die "connect: $!"; + nstore_fd($packet, \*SOCK) or die "can't send packet: $!"; + SOCK->flush; -A. U. Thor, Ea.u.thor@a.galaxy.far.far.awayE + #shoudl trap: Magic number checking on storable file failed at blib/lib/Storable.pm (autosplit into blib/lib/auto/Storable/fd_retrieve.al) line 337, at /usr/local/share/perl/5.6.1/FS/SelfService.pm line 71 + + #block until there is a message on socket +# my $w = new IO::Select; +# $w->add(\*SOCK); +# my @wait = $w->can_read; + my $return = fd_retrieve(\*SOCK) or die "error reading result: $!"; + die $return->{'_error'} if defined $return->{_error} && $return->{_error}; + + $return->{'error'}; +} + +=back + +=head1 BUGS =head1 SEE ALSO -L. +L, L =cut + +1; + diff --git a/fs_selfservice/FS-SelfService/freeside-selfservice-clientd b/fs_selfservice/FS-SelfService/freeside-selfservice-clientd new file mode 100644 index 000000000..149f894e0 --- /dev/null +++ b/fs_selfservice/FS-SelfService/freeside-selfservice-clientd @@ -0,0 +1,222 @@ +#!/usr/bin/perl -w +# +# freeside-selfservice-clientd +# +# This is run REMOTELY over ssh by freeside-selfservice-server + +use strict; +use subs qw(spawn logmsg); +use Fcntl qw(:flock); +use Socket; +use Storable qw(nstore_fd fd_retrieve); +use IO::Handle; +use IO::Select; +use IPC::Open2; + +use LockFile::Simple qw(lock unlock); + +use vars qw( $Debug ); +$Debug = 2; + +my $socket = "/usr/local/freeside/selfservice_socket"; +my $pid_file = "$socket.pid"; +my $lock_file = "$socket.lock"; +unlink $lock_file; + +my $me = '[client]'; + +$|=1; + +#read data to be cached or something +#warn "$me Reading init data\n" if $Debug; +#my $signup_init = + +warn "[client] Creating $socket\n" if $Debug; +my $uaddr = sockaddr_un($socket); +my $proto = getprotobyname('tcp'); +socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!"; +unlink($socket); +bind(Server, $uaddr) or die "bind: $!"; +listen(Server,SOMAXCONN) or die "listen: $!"; + +if ( -e $pid_file ) { + open(PIDFILE,"<$pid_file"); + #chomp( my $old_pid = ); + my $old_pid = ; + close PIDFILE; + $old_pid =~ /^(\d+)$/; + kill 'TERM', $1; +} +open(PIDFILE,">$pid_file"); +print PIDFILE "$$\n"; +close PIDFILE; + +#my $waitedpid; +#sub REAPER { $waitedpid = wait; $SIG{CHLD} = \&REAPER; } +#$SIG{CHLD} = \&REAPER; + +warn "[client] entering main loop\n" if $Debug; + +#sub spawn; +#sub logmsg; + +my %kids; + + # my $gar = ; + +#my $s = new IO::Select; +#$s->add(\*STDIN); +#$s->add(\*Server); + +#for ( $waitedpid = 0; +# accept(Client,Server) || $waitedpid; +# $waitedpid = 0, close Client) +#{ +# next if $waitedpid; + +#$SIG{PIPE} = sub { warn "SIGPIPE received" }; +#$SIG{CHLD} = sub { warn "SIGCHLD received" }; + +sub REAPER { warn "SIGCHLD received"; my $pid = wait; $SIG{CHLD} = \&REAPER; } +#sub REAPER { my $pid = wait; delete $kids{$pid}; $SIG{CHLD} = \&REAPER; } +$SIG{CHLD} = \&REAPER; + +warn "[client] creating IO::Select\n" if $Debug; +my $s = new IO::Select; +$s->add(\*STDIN); +$s->add(\*Server); + +while (1) { + +warn "[client] waiting for connection or token\n" if $Debug; +while ( my @handles = $s->can_read ) { + + foreach my $handle ( @handles ) { + + if ( $handle == \*STDIN ) { + +# my $gar = ; +# die $gar; + + my $packet = fd_retrieve(\*STDIN); + my $token = $packet->{'_token'}; + warn "[client] received packet with token $token\n". + join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + if $Debug; + if ( exists($kids{$token}) ) { + warn "[client] sending return packet to $token via $kids{$token}\n" + if $Debug; + nstore_fd($packet, $kids{$token}); + warn "[client] flushing $kids{$token}\n" if $Debug; + $kids{$token}->flush; + #eval { $kids{$token}->flush; }; + #die "error flushing?!?!? $@\n" if $@ ne ''; + #warn "[client] closing $kids{$token}\n"; + #close $kids{$token}; + #warn "[client] deleting $kids{$token}\n"; + #delete $kids{$token}; + warn "[client] done with $token\n" if $Debug; + } else { + warn "[client] WARNING: unknown token $token, discarding message"; + #die "[client] FATAL: unknown token $token, discarding message"; + } + + } elsif ( $handle == \*Server ) { + + warn "[client] received local connection; forking\n" if $Debug; + + accept(Client, Server); + + spawn sub { #child + warn "[client-$$] reading packet from local client" if $Debug > 1; + my $packet = fd_retrieve(\*Client); + warn "[client-$$] packet received:\n". + join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + if $Debug > 1; + my $command = $packet->{'command'}; + #handle some commands weirdly? + $packet->{_token}=$$; #?? + + warn "[client-$$] sending packet to remote server" if $Debug > 1; + flock(STDOUT, LOCK_EX); #acquire write lock + #lock($lock_file); + nstore_fd($packet, \*STDOUT); + STDOUT->flush; + #unlock($lock_file); + flock(STDOUT, LOCK_UN); #release write lock + + warn "[client-$$] waiting for response from parent" if $Debug > 1; + + #block until parent has a message + my $w = new IO::Select; + $w->add(\*STDIN); + my @wait = $w->can_read; + my $rv = fd_retrieve(\*STDIN); + + #close STDIN; + + warn "[client-$$] sending response to local client" if $Debug > 1; + + #send message to local client + nstore_fd($rv, \*Client); + Client->flush; + + close Client; + + warn "[client-$$] child exiting" if $Debug > 1; + + #while (1) { sleep 5 }; + #sleep 5; + exit; + + }; #eo child + + #close Client; #in parent, right? + + } else { + die "wtf? $handle"; + } + + } + + warn "[client] done handling messages; returning to wait-state" if $Debug;; + +} + +#die "[client] died unexpectedly: $!\n"; +warn "[client] fell-through unexpectedly: $!\n" if $Debug; + +} #WTF? + +sub spawn { + my $coderef = shift; + + unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { + use Carp; + confess "usage: spawn CODEREF"; + } + + my $pid; + #if (!defined($pid = fork)) { + my $kid = new IO::Handle; + if (!defined($pid = open($kid, '|-'))) { + logmsg "WARNING: cannot fork: $!"; + return; + } elsif ($pid) { + logmsg "begat $pid" if $Debug; + $kids{$pid} = $kid; + #$kids{$pid}->autoflush; + return; # I'm the parent + } + # else I'm the child -- go spawn + +# open(STDIN, "<&Client") || die "can't dup client to stdin"; +# open(STDOUT, ">&Client") || die "can't dup client to stdout"; + ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; + exit &$coderef(); +} + +#sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } +#DON'T PRINT!!!!! +sub logmsg { warn "[client] $0 $$: @_ at ", scalar localtime, "\n" } + diff --git a/fs_selfservice/freeside-selfservice-server b/fs_selfservice/freeside-selfservice-server index 6146d3752..7b4a88166 100644 --- a/fs_selfservice/freeside-selfservice-server +++ b/fs_selfservice/freeside-selfservice-server @@ -12,10 +12,13 @@ use vars qw( $kids $max_kids $shutdown $log_file ); use vars qw($ssh_pid); use Fcntl qw(:flock); use POSIX qw(setsid); +use Date::Format; use IO::Handle; use Storable qw(nstore_fd fd_retrieve); use Net::SSH qw(sshopen2); -use FS::UID qw(adminsuidsetup); +use FS::UID qw(adminsuidsetup forksuidsetup); + +use LockFile::Simple qw(lock unlock); #use Tie::RefHash; #use FS::Conf; @@ -32,6 +35,8 @@ my $user = shift or die &usage; my $machine = shift or die &usage; my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; #my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; $FS::UID::datasrc not posible, but should include machine name at least, hmm +my $lock_file = "/usr/local/etc/freeside/freeside-selfservice-server.$user.lock"; +unlink $lock_file; &init($user); @@ -47,51 +52,64 @@ my %dispatch = ( my $warnkids=0; while (1) { my($reader, $writer) = (new IO::Handle, new IO::Handle); - warn "connecting to $machine"; + warn "connecting to $machine\n"; $ssh_pid = sshopen2($machine,$reader,$writer,$clientd); - warn "entering main loop"; +# nstore_fd(\*writer, {'hi'=>'there'}); + + warn "entering main loop\n"; + my $undisp = 0; while (1) { - warn "waiting for packet from client"; + warn "waiting for packet from client\n" unless $undisp; + $undisp = 1; my $packet = eval { local $SIG{__DIE__}; - local $SIG{ALRM} = sub { die "alarm\n" }; #NB: \n required + local $SIG{ALRM} = sub { local $SIG{__DIE__};die "MyAlarm\n" }; #NB: \n required alarm 5; + #my $string = <$reader>; + #die $string; my $p = fd_retrieve($reader); alarm 0; $p; }; if ($@) { - die $@ unless $@ eq "alarm\n"; + &shutdown if $shutdown && $@; + die "Fatal error receiving packet from client: $@" if $@ !~ /^MyAlarm/; + #die $@ unless $@ eq "alarm\n" || $@ eq 'Alarm'; #????? #timeout next unless $shutdown; &shutdown; } - warn "packet received"; + warn "packet received\n". + join('', map { " $_=>$packet->{$_}\n" } keys %$packet ); + + $undisp = 0; #prevent runaway forking my $warnkids = 0; while ( $kids >= $max_kids ) { - warn "WARNING: maximum $kids children reached" unless $warnkids++; + warn "WARNING: maximum $kids children reached\n" unless $warnkids++; sleep 1; } - warn "forking child"; + warn "forking child\n"; defined( my $pid = fork ) or die "can't fork: $!"; if ( $pid ) { - warn "child $pid spawned"; + warn "child $pid spawned\n"; $kids++; } else { #kid time + #local($SIG{PIPE}); + #get new db handle - $FS::UID::dbh->{InactiveDestroy} = 1; + #$FS::UID::dbh->{InactiveDestroy} = 1; forksuidsetup($user); my $sub = $dispatch{$packet->{_packet}}; my $rv; if ( $sub ) { - warn "calling $sub handler"; + warn "calling $sub handler\n"; $rv = &{$sub}($packet); } else { warn my $error = "WARNING: unknown packet type ". $packet->{_packet}; @@ -99,13 +117,15 @@ while (1) { } $rv->{_token} = $packet->{_token}; #identifier - warn "sending response"; + warn "sending response\n"; flock($writer, LOCK_EX); #acquire write lock + #lock($lock_file); nstore_fd($rv, $writer) or die "can't send response: $!"; $writer->flush; + #unlock($lock_file); flock($writer, LOCK_UN); #release write lock - - warn "child exiting"; +# + warn "child exiting\n"; exit; #end-of-kid } @@ -114,6 +134,50 @@ while (1) { } ### +# dispatch subroutines (should live elsewhere eventually) +### + +sub passwd { + #sleep 3; + use FS::Record qw(qsearchs); + use FS::svc_acct; + #use FS::svc_domain; + + my $packet = shift; + + #my $domain = qsearchs('svc_domain', { 'domain' => $packet->{'domain'} } ) + # or return { error => "Domain $domain not found" }; + + my $old_password = $packet->{'old_password'}; + my $new_password = $packet->{'new_password'}; + my $new_gecos = $packet->{'new_gecos'}; + my $new_shell = $packet->{'new_shell'}; + + my $svc_acct = + ( length($old_password) < 13 + && qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, + #'domsvc' => $svc_domain->domsvc, + '_password' => $old_password } ) + ) + || qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, + #'domsvc' => $svc_domain->domsvc, + '_password' => $old_password } ); + + unless ( $svc_acct ) { return { error => 'Incorrect password.' } } + + my %hash = $svc_acct->hash; + my $new_svc_acct = new FS::svc_acct ( \%hash ); + $new_svc_acct->setfield('_password', $new_password ) + if $new_password && $new_password ne $old_password; + $new_svc_acct->setfield('finger',$new_gecos) if $new_gecos; + $new_svc_acct->setfield('shell',$new_shell) if $new_shell; + my $error = $new_svc_acct->replace($svc_acct); + + return { error => $error }; + +} + +### # utility subroutines ### @@ -143,6 +207,23 @@ sub init { $> = $FS::UID::freeside_uid unless $>; $< = $>; + + #false laziness w/freeside-queued + my $freeside_gid = scalar(getgrnam('freeside')) + or die "can't setgid to freeside group\n"; + $) = $freeside_gid; + $( = $freeside_gid; + #if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd + ($(,$)) = ($),$(); + $) = $freeside_gid; + + $> = $FS::UID::freeside_uid; + $< = $FS::UID::freeside_uid; + #freebsd is sofa king broken, won't setuid() + ($<,$>) = ($>,$<); + $> = $FS::UID::freeside_uid; + #eslaf + $ENV{HOME} = (getpwuid($>))[7]; #for ssh adminsuidsetup $user; @@ -152,7 +233,7 @@ sub init { open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!"; setsid or die "Can't start a new session: $!"; - open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; +# open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; $SIG{__DIE__} = \&_die; $SIG{__WARN__} = \&_logmsg; @@ -163,7 +244,7 @@ sub init { sub shutdown { my $wait = 12; #wait up to 1 minute - while ( $kids && $wait-- ) { + while ( $kids > 0 && $wait-- ) { warn "waiting for $kids children to terminate"; sleep 5; } diff --git a/fs_selfservice/fs_passwd_test b/fs_selfservice/fs_passwd_test new file mode 100755 index 000000000..77782e651 --- /dev/null +++ b/fs_selfservice/fs_passwd_test @@ -0,0 +1,14 @@ +#!/usr/bin/perl -w + +use strict; +use FS::SelfService qw(passwd); + +my $error = passwd( + 'username' => 'ivan', + 'old_password' => 'heyhoo', + 'new_password' => 'haloo', +); + +die $error if $error; + +print "password changed sucessfully\n"; -- 2.11.0