From b4d172efa2225ef5070c1a6f168eb98fce8c5c62 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 29 May 2002 04:40:31 +0000 Subject: [PATCH] add fs_selfservice --- fs_selfservice/FS-SelfService/Changes | 6 + fs_selfservice/FS-SelfService/MANIFEST | 6 + fs_selfservice/FS-SelfService/Makefile.PL | 15 ++ fs_selfservice/FS-SelfService/SelfService.pm | 66 +++++++++ fs_selfservice/FS-SelfService/test.pl | 17 +++ fs_selfservice/freeside-selfservice-server | 198 +++++++++++++++++++++++++++ 6 files changed, 308 insertions(+) create mode 100644 fs_selfservice/FS-SelfService/Changes create mode 100644 fs_selfservice/FS-SelfService/MANIFEST create mode 100644 fs_selfservice/FS-SelfService/Makefile.PL create mode 100644 fs_selfservice/FS-SelfService/SelfService.pm create mode 100644 fs_selfservice/FS-SelfService/test.pl create mode 100644 fs_selfservice/freeside-selfservice-server diff --git a/fs_selfservice/FS-SelfService/Changes b/fs_selfservice/FS-SelfService/Changes new file mode 100644 index 000000000..b9e26b7dc --- /dev/null +++ b/fs_selfservice/FS-SelfService/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension FS::SelfService. + +0.01 Tue May 28 16:49:41 2002 + - original version; created by h2xs 1.21 with options + -A -X -n FS::SelfService + diff --git a/fs_selfservice/FS-SelfService/MANIFEST b/fs_selfservice/FS-SelfService/MANIFEST new file mode 100644 index 000000000..3c490e7dd --- /dev/null +++ b/fs_selfservice/FS-SelfService/MANIFEST @@ -0,0 +1,6 @@ +Changes +Makefile.PL +MANIFEST +README +SelfService.pm +test.pl diff --git a/fs_selfservice/FS-SelfService/Makefile.PL b/fs_selfservice/FS-SelfService/Makefile.PL new file mode 100644 index 000000000..da0a0aa24 --- /dev/null +++ b/fs_selfservice/FS-SelfService/Makefile.PL @@ -0,0 +1,15 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'FS::SelfService', + 'VERSION_FROM' => 'SelfService.pm', # finds $VERSION + 'EXE_FILES' => [ 'freeside-selfservice-clientd' ], + 'INSTALLSCRIPT' => '/usr/local/sbin', + 'INSTALLSITEBIN' => '/usr/local/sbin', + 'PERM_RWX' => '750', + 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'SelfService.pm', # retrieve abstract from module + AUTHOR => 'Ivan Kohler ') : ()), +); diff --git a/fs_selfservice/FS-SelfService/SelfService.pm b/fs_selfservice/FS-SelfService/SelfService.pm new file mode 100644 index 000000000..75e550a2d --- /dev/null +++ b/fs_selfservice/FS-SelfService/SelfService.pm @@ -0,0 +1,66 @@ +package FS::SelfService; + +use 5.006; +use strict; +use warnings; + +require Exporter; + +our @ISA = qw(Exporter); + +# 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. + +# 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( + +) ] ); + +our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +our @EXPORT = qw( + +); +our $VERSION = '0.01'; + + +# Preloaded methods go here. + +1; +__END__ +# Below is stub documentation for your module. You better edit it! + +=head1 NAME + +FS::SelfService - Perl extension for blah blah blah + +=head1 SYNOPSIS + + use FS::SelfService; + blah blah blah + +=head1 DESCRIPTION + +Stub documentation for FS::SelfService, created by h2xs. It looks like the +author of the extension was negligent enough to leave the stub +unedited. + +Blah blah blah. + +=head2 EXPORT + +None by default. + + +=head1 AUTHOR + +A. U. Thor, Ea.u.thor@a.galaxy.far.far.awayE + +=head1 SEE ALSO + +L. + +=cut diff --git a/fs_selfservice/FS-SelfService/test.pl b/fs_selfservice/FS-SelfService/test.pl new file mode 100644 index 000000000..7468ea471 --- /dev/null +++ b/fs_selfservice/FS-SelfService/test.pl @@ -0,0 +1,17 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use Test; +BEGIN { plan tests => 1 }; +use FS::SelfService; +ok(1); # If we made it this far, we're ok. + +######################### + +# Insert your test code below, the Test module is use()ed here so read +# its man page ( perldoc Test ) for help writing this test script. + diff --git a/fs_selfservice/freeside-selfservice-server b/fs_selfservice/freeside-selfservice-server new file mode 100644 index 000000000..6146d3752 --- /dev/null +++ b/fs_selfservice/freeside-selfservice-server @@ -0,0 +1,198 @@ +#!/usr/bin/perl -w +# +# freeside-selfservice-server + +# alas, much false laziness with freeside-queued and fs_signup_server. at +# least it is slated to replace fs_{signup,passwd,mailadmin}_server +# should probably generalize the version in here, or better yet use +# Proc::Daemon or somesuch + +use strict; +use vars qw( $kids $max_kids $shutdown $log_file ); +use vars qw($ssh_pid); +use Fcntl qw(:flock); +use POSIX qw(setsid); +use IO::Handle; +use Storable qw(nstore_fd fd_retrieve); +use Net::SSH qw(sshopen2); +use FS::UID qw(adminsuidsetup); + +#use Tie::RefHash; +#use FS::Conf; +#use FS::Record qw( qsearch qsearchs ); +#use FS::cust_main_county; +#use FS::cust_main; +#use FS::Msgcat qw(gettext); + +$shutdown = 0; +$max_kids = '10'; #? +$kids = 0; + +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 + +&init($user); + +my $clientd = "/usr/local/sbin/freeside-selfservice-clientd"; #better name? + +my %dispatch = ( + 'signup' => \&signup, + #'signup_init' => 'signup_init', + 'passwd' => \&passwd, + +); + +my $warnkids=0; +while (1) { + my($reader, $writer) = (new IO::Handle, new IO::Handle); + warn "connecting to $machine"; + $ssh_pid = sshopen2($machine,$reader,$writer,$clientd); + + warn "entering main loop"; + while (1) { + + warn "waiting for packet from client"; + my $packet = eval { + local $SIG{__DIE__}; + local $SIG{ALRM} = sub { die "alarm\n" }; #NB: \n required + alarm 5; + my $p = fd_retrieve($reader); + alarm 0; + $p; + }; + if ($@) { + die $@ unless $@ eq "alarm\n"; + #timeout + next unless $shutdown; + &shutdown; + } + warn "packet received"; + + #prevent runaway forking + my $warnkids = 0; + while ( $kids >= $max_kids ) { + warn "WARNING: maximum $kids children reached" unless $warnkids++; + sleep 1; + } + + warn "forking child"; + defined( my $pid = fork ) or die "can't fork: $!"; + if ( $pid ) { + warn "child $pid spawned"; + $kids++; + } else { #kid time + + #get new db handle + $FS::UID::dbh->{InactiveDestroy} = 1; + forksuidsetup($user); + + my $sub = $dispatch{$packet->{_packet}}; + my $rv; + if ( $sub ) { + warn "calling $sub handler"; + $rv = &{$sub}($packet); + } else { + warn my $error = "WARNING: unknown packet type ". $packet->{_packet}; + $rv = { _error => $error }; + } + $rv->{_token} = $packet->{_token}; #identifier + + warn "sending response"; + flock($writer, LOCK_EX); #acquire write lock + nstore_fd($rv, $writer) or die "can't send response: $!"; + $writer->flush; + flock($writer, LOCK_UN); #release write lock + + warn "child exiting"; + exit; #end-of-kid + } + + } + +} + +### +# utility subroutines +### + +sub init { + my $user = shift; + + chdir "/" or die "Can't chdir to /: $!"; + open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; + defined(my $pid = fork) or die "Can't fork: $!"; + if ( $pid ) { + print "freeside-selfservice-server to $machine started with pid $pid\n"; #logging to $log_file + exit unless $pid_file; + my $pidfh = new IO::File ">$pid_file" or exit; + print $pidfh "$pid\n"; + exit; + } + + sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } + $SIG{CHLD} = \&REAPER; + + $shutdown = 0; + $SIG{HUP} = sub { warn "SIGHUP received; shutting down\n"; $shutdown++; }; + $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $shutdown++; }; + $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $shutdown++; }; + $SIG{QUIT} = sub { warn "SIGQUIT received; shutting down\n"; $shutdown++; }; + $SIG{PIPE} = sub { warn "SIGPIPE received; shutting down\n"; $shutdown++; }; + + $> = $FS::UID::freeside_uid unless $>; + $< = $>; + $ENV{HOME} = (getpwuid($>))[7]; #for ssh + adminsuidsetup $user; + + #$log_file = "/usr/local/etc/freeside/selfservice.". $FS::UID::datasrc; #MACHINE NAME + $log_file = "/usr/local/etc/freeside/selfservice.$machine.log"; + + 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: $!"; + + $SIG{__DIE__} = \&_die; + $SIG{__WARN__} = \&_logmsg; + + warn "freeside-selfservice-server starting\n"; + +} + +sub shutdown { + my $wait = 12; #wait up to 1 minute + while ( $kids && $wait-- ) { + warn "waiting for $kids children to terminate"; + sleep 5; + } + warn "abandoning $kids children" if $kids; + kill 'TERM', $ssh_pid if $ssh_pid; + die "exiting"; +} + +sub _die { + my $msg = shift; + unlink $pid_file if -e $pid_file; + _logmsg($msg); +} + +sub _logmsg { + chomp( my $msg = shift ); + my $log = new IO::File ">>$log_file"; + flock($log, LOCK_EX); + seek($log, 0, 2); + print $log "[server] [". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n"; + flock($log, LOCK_UN); + close $log; +} + +sub usage { + die "Usage:\n\n fs_signup_server user machine\n"; +} + +### +# handlers... should go in their own files eventually... +### + -- 2.11.0