diff options
Diffstat (limited to 'fs_selfservice')
-rwxr-xr-x | fs_selfservice/DEPLOY | 15 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/Changes | 6 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/MANIFEST | 6 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/Makefile.PL | 15 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/SelfService.pm | 112 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/cgi/login.html | 23 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/cgi/myaccount.html | 47 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/cgi/passwd.html | 25 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/cgi/selfservice.cgi | 109 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/cgi/view_invoice.html | 21 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/freeside-selfservice-clientd | 226 | ||||
-rw-r--r-- | fs_selfservice/FS-SelfService/test.pl | 17 | ||||
-rw-r--r-- | fs_selfservice/freeside-selfservice-server | 224 | ||||
-rwxr-xr-x | fs_selfservice/fs_passwd_test | 19 |
14 files changed, 865 insertions, 0 deletions
diff --git a/fs_selfservice/DEPLOY b/fs_selfservice/DEPLOY new file mode 100755 index 000000000..7c68e78ec --- /dev/null +++ b/fs_selfservice/DEPLOY @@ -0,0 +1,15 @@ +#!/bin/sh + +( cd ..; make deploy; cd fs_selfservice ) + +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 + +cp /home/ivan/freeside_current/fs_selfservice/FS-SelfService/cgi/* /var/www/MyAccount +chown freeside /var/www/MyAccount/selfservice.cgi +chmod 4755 /var/www/MyAccount/selfservice.cgi +ln -s /var/www/MyAccount/selfservice.cgi /var/www/MyAccount/index.cgi 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..ebd0d3b1a --- /dev/null +++ b/fs_selfservice/FS-SelfService/MANIFEST @@ -0,0 +1,6 @@ +Changes +Makefile.PL +MANIFEST +SelfService.pm +test.pl +freeside-selfservice-clientd 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 <ivan-freeside-selfservice@420.am>') : ()), +); diff --git a/fs_selfservice/FS-SelfService/SelfService.pm b/fs_selfservice/FS-SelfService/SelfService.pm new file mode 100644 index 000000000..9019ea4f8 --- /dev/null +++ b/fs_selfservice/FS-SelfService/SelfService.pm @@ -0,0 +1,112 @@ +package FS::SelfService; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK $socket %autoload ); +use Exporter; +use Socket; +use FileHandle; +#use IO::Handle; +use IO::Select; +use Storable qw(nstore_fd fd_retrieve); + +$VERSION = '0.03'; + +@ISA = qw( Exporter ); + +$socket = "/usr/local/freeside/selfservice_socket"; + +%autoload = ( + 'passwd' => 'passwd/passwd', + 'chfn' => 'passwd/passwd', + 'chsh' => 'passwd/passwd', + 'login' => 'MyAccount/login', + 'customer_info' => 'MyAccount/customer_info', + 'invoice' => 'MyAccount/invoice', +); +@EXPORT_OK = keys %autoload; + +$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin'; +$ENV{'SHELL'} = '/bin/sh'; +$ENV{'IFS'} = " \t\n"; +$ENV{'CDPATH'} = ''; +$ENV{'ENV'} = ''; +$ENV{'BASH_ENV'} = ''; + +my $freeside_uid = scalar(getpwnam('freeside')); +die "not running as the freeside user\n" if $> != $freeside_uid; + +=head1 NAME + +FS::SelfService - Freeside self-service API + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +Use this API to implement your own client "self-service" module. + +If you just want to customize the look of the existing "self-service" module, +see XXXX instead. + +=head1 FUNCTIONS + +=over 4 + +=item passwd + +Returns the empty value on success, or an error message on errors. + +=cut + +foreach my $autoload ( keys %autoload ) { + + my $eval = + "sub $autoload { ". ' + my $param; + if ( ref($_[0]) ) { + $param = shift; + } else { + $param = { @_ }; + } + + $param->{_packet} = \''. $autoload{$autoload}. '\'; + + simple_packet($param); + }'; + + eval $eval; + die $@ if $@; + +} + +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; + + #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; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<freeside-selfservice-clientd>, L<freeside-selfservice-server> + +=cut + +1; + diff --git a/fs_selfservice/FS-SelfService/cgi/login.html b/fs_selfservice/FS-SelfService/cgi/login.html new file mode 100644 index 000000000..dfbd0137a --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/login.html @@ -0,0 +1,23 @@ +<HTML><HEAD><TITLE>Login</TITLE></HEAD> +<BODY BGCOLOR="#e8e8e8"><FONT SIZE=5>Login</FONT><BR><BR> +<FONT SIZE="+1" COLOR="#ff0000"><%= $error %></FONT> +<FORM ACTION="<%= $self_url %>" METHOD=POST> +<INPUT TYPE="hidden" NAME="session" VALUE="login"> +<TABLE BGCOLOR="#c0c0c0" BORDER=0 CELLSPACING=2 CELLPADDING=0> +<TR> + <TH ALIGN="right">Username </TH> + <TD><INPUT TYPE="text" NAME="username" VALUE="<%= $username %>"></TD> +</TR> +<TR> + <TH ALIGN="right">Domain </TH> + <TD><INPUT TYPE="text" NAME="domain" VALUE="<%= $domain %>"></TD> +</TR> +<!--<INPUT TYPE="hidden" NAME="domain" VALUE="myisp.com">--> +<TR> + <TH ALIGN="right">Password </TH> + <TD><INPUT TYPE="password" NAME="password"></TD> +</TR> +</TABLE> +<BR><BR><INPUT TYPE="submit" VALUE="Login"> +</FORM></BODY></HTML> + diff --git a/fs_selfservice/FS-SelfService/cgi/myaccount.html b/fs_selfservice/FS-SelfService/cgi/myaccount.html new file mode 100644 index 000000000..f8a916eea --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/myaccount.html @@ -0,0 +1,47 @@ +<HTML><HEAD><TITLE>MyAccount</TITLE></HEAD> +<BODY BGCOLOR="#eeeeee"><FONT SIZE=5>MyAccount</FONT><BR><BR> +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<TABLE BORDER=0 CELLPADDING=4><TR><TD VALIGN="top" HEIGHT=384 BGCOLOR="#dddddd"> +<A HREF="<%= $url %>myaccount">MyAccount</A><BR> +<A HREF="<%= $url %>other">SomethingElse</A><BR> +</TD><TD VALIGN="top"> + +Hello <%= $name %>!<BR><BR> +Your customer number is <%= $custnum %><BR><BR> +Your contact information<BR><%= $small_custview %> +Your outstanding balance is $<%= $balance %><BR><BR> +<!--<TABLE BORDER=1 CELLSPACING=0 CELLPADDING=2 BORDERCOLOR="#999999"> +<TR><TH>Invoice</TH><TH>Date</TH><TH>Owed</TH></TR>--> +<%= + if ( @open_invoices ) { + $OUT .= '<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=2 BGCOLOR="#eeeeee">'. + '<TR><TH BGCOLOR="#ff3333" COLSPAN=5>Open Invoices</TH><TD>'; + my $link = qq!<A HREF="<%= $selfurl %>?session=<%= $session_id %>;action=myaccount!; + my $col1 = "ffffff"; + my $col2 = "dddddd"; + my $col = $col1; + + foreach my $invoice ( @open_invoices ) { + my $td = qq!<TD BGCOLOR="#$col">!; + my $a=qq!<A HREF="${url}view_invoice;invnum=!. $invoice->{'invnum'}. '">'; + $OUT .= + "<TR>$td${a}Invoice #". $invoice->{'invnum'}. "</A></TD>$td</TD>". + "$td$a". $invoice->{'date'}. "</A></TD>$td</TD>". + qq!<TD BGCOLOR="#$col" ALIGN="right">$a\$!. $invoice->{'owed'}. + '</A></TD>'. + '</TR>'; + $col = $col eq $col1 ? $col2 : $col1; + } + $OUT .= '</TABLE>'; + } else { + $OUT .= 'You have no outstanding invoices.<BR><BR>'; + } +%> + +</TD></TR></TABLE> +<HR> +<FONT SIZE="-2">small text</FONT> +</BODY></HTML> + + + diff --git a/fs_selfservice/FS-SelfService/cgi/passwd.html b/fs_selfservice/FS-SelfService/cgi/passwd.html new file mode 100644 index 000000000..fadc4df8b --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/passwd.html @@ -0,0 +1,25 @@ +<html> + <head> + <title>Change password</title> + </head> + <body bgcolor="#e8e8e8"> + <h3>Change password</h3> + <form action="/cgi-bin/fs_passwd.cgi" method="post"> + <table bgcolor="#cccccc" border=0 cellspacing=2> + <tr><th align="right">Username</th> + <td><input type="text" name="username" size="18"></td> + </tr> + <tr><th align="right">Current password</th> + <td><input type="password" name="old_password" size="18"></td> + </tr> + <tr><th align="right">New password</th> + <td><input type="password" name="new_password" size="18"></td> + </tr> + <tr><th align="right">Re-enter new password</th> + <td><input type="password" name="new_password2" size="18"></td> + </tr> + </table> + <br><input type="submit" value="Change password"> + </body> +</html> + diff --git a/fs_selfservice/FS-SelfService/cgi/selfservice.cgi b/fs_selfservice/FS-SelfService/cgi/selfservice.cgi new file mode 100644 index 000000000..eae373931 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/selfservice.cgi @@ -0,0 +1,109 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw($cgi $session_id $form_max $template_dir); +use subs qw(do_template); +use CGI; +use CGI::Carp qw(fatalsToBrowser); +use Text::Template; +use FS::SelfService qw(login customer_info invoice); + +$template_dir = '.'; + +$form_max = 255; + +$cgi = new CGI; + +unless ( defined $cgi->param('session') ) { + do_template('login',{}); + exit; +} + +if ( $cgi->param('session') eq 'login' ) { + + $cgi->param('username') =~ /^\s*([a-z0-9_\-\.\&]{0,$form_max})\s*$/i + or die "illegal username"; + my $username = $1; + + $cgi->param('domain') =~ /^\s*([\w\-\.]{0,$form_max})\s*$/ + or die "illegal domain"; + my $domain = $1; + + $cgi->param('password') =~ /^(.{0,$form_max})$/ + or die "illegal password"; + my $password = $1; + + my $rv = login( + 'username' => $username, + 'domain' => $domain, + 'password' => $password, + ); + if ( $rv->{error} ) { + do_template('login', { + 'error' => $rv->{error}, + 'username' => $username, + 'domain' => $domain, + } ); + exit; + } else { + $cgi->param('session' => $rv->{session_id} ); + $cgi->param('action' => 'myaccount' ); + } +} + +$session_id = $cgi->param('session'); + +$cgi->param('action') =~ /^(myaccount|view_invoice)$/ + or die "unknown action ". $cgi->param('action'); +my $action = $1; + +my $result = eval "&$action();"; +die $@ if $@; + +if ( $result->{error} eq "Can't resume session" ) { #ick + do_template('login',{}); + exit; +} + +#warn $result->{'open_invoices'}; +#warn scalar(@{$result->{'open_invoices'}}); + +do_template($action, { + 'session_id' => $session_id, + %{$result} +}); + +#-- + +sub myaccount { customer_info( 'session_id' => $session_id ); } + +sub view_invoice { + + $cgi->param('invnum') =~ /^(\d+)$/ or die "illegal invnum"; + my $invnum = $1; + + invoice( 'session_id' => $session_id, + 'invnum' => $invnum, + ); + +} + +#-- + +sub do_template { + my $name = shift; + my $fill_in = shift; + + $cgi->delete_all(); + $fill_in->{'self_url'} = $cgi->self_url; + + my $template = new Text::Template( TYPE => 'FILE', + SOURCE => "$template_dir/$name.html", + DELIMITERS => [ '<%=', '%>' ], + UNTAINT => 1, ) + or die $Text::Template::ERROR; + + print $cgi->header( '-expires' => 'now' ), + $template->fill_in( HASH => $fill_in ); +} + diff --git a/fs_selfservice/FS-SelfService/cgi/view_invoice.html b/fs_selfservice/FS-SelfService/cgi/view_invoice.html new file mode 100644 index 000000000..33388de99 --- /dev/null +++ b/fs_selfservice/FS-SelfService/cgi/view_invoice.html @@ -0,0 +1,21 @@ +<HTML><HEAD><TITLE>MyAccount</TITLE></HEAD> +<BODY BGCOLOR="#eeeeee"><FONT SIZE=5>MyAccount</FONT><BR><BR> +<%= $url = "$selfurl?session=$session_id;action="; ''; %> +<TABLE BORDER=0 CELLPADDING=4><TR><TD VALIGN="top" HEIGHT=384 BGCOLOR="#dddddd"> +<A HREF="<%= $url %>myaccount">MyAccount</A><BR> +<A HREF="<%= $url %>other">SomethingElse</A><BR> +</TD><TD VALIGN="top"> + +<A HREF="<%= $url %>myaccount"><-- back to MyAccount</A><BR><BR> + +<FONT SIZE="-1"><PRE> +<%= $invoice_text %> +</FONT></PRE> + +</TD></TR></TABLE> +<HR> +<FONT SIZE="-2">small text</FONT> +</BODY></HTML> + + + diff --git a/fs_selfservice/FS-SelfService/freeside-selfservice-clientd b/fs_selfservice/FS-SelfService/freeside-selfservice-clientd new file mode 100644 index 000000000..0c25c3407 --- /dev/null +++ b/fs_selfservice/FS-SelfService/freeside-selfservice-clientd @@ -0,0 +1,226 @@ +#!/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 POSIX qw(:sys_wait_h); +use Socket; +use Storable qw(nstore_fd fd_retrieve); +use IO::Handle qw(_IONBF); +use IO::Select; +use IO::File; + +STDOUT->setbuf(''); + +use vars qw( $Debug ); +$Debug = 3; #2 will turn on child logging, 3 will log packet contents, + #including potentially compromising information + +my $socket = "/usr/local/freeside/selfservice_socket"; +my $pid_file = "$socket.pid"; + +my $log_file = "/usr/local/freeside/selfservice.log"; + +#my $me = '[client]'; + +$|=1; + +$SIG{__WARN__} = \&_logmsg; + +#read data to be cached or something +#warn "$me Reading init data\n" if $Debug; +#my $signup_init = + +warn "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"); + my $old_pid = <PIDFILE>; + 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 "entering main loop\n" if $Debug; + +my %kids; + +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; $SIG{CHLD} = \&REAPER; } +#sub REAPER { my $pid = wait; delete $kids{$pid}; $SIG{CHLD} = \&REAPER; } +#$SIG{CHLD} = \&REAPER; + +my $undisp = 0; +while (1) { + + &reap_kids; + + warn "waiting for connection\n" if $Debug && !$undisp; + + #my @handles = $s->can_read(); + my @handles = $s->can_read(5); + $undisp = !scalar(@handles); + foreach my $handle ( @handles ) { + + if ( $handle == \*STDIN ) { + + warn "receiving packet from server\n" if $Debug; + + my $packet = fd_retrieve(\*STDIN); + my $token = $packet->{'_token'}; + warn "received packet from server with token $token\n". + ( $Debug > 2 + ? join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + : '' ) + if $Debug; + + if ( exists($kids{$token}) ) { + warn "sending return packet to $token via $kids{$token}\n" + if $Debug; + nstore_fd($packet, $kids{$token}); + warn "flushing to $token\n" if $Debug; + until ( $kids{$token}->flush ) { + warn "WARNING: error flushing: $!"; + sleep 1; + } + #no close or delete here - will block waiting for child + warn "done with $token\n" if $Debug; + } else { + warn "WARNING: unknown token $token, discarding message"; + } + + } elsif ( $handle == \*Server ) { + + until ( accept(Client, Server) ) { + warn "WARNING: accept failed: $!"; + next; + } + + warn "received local connection; forking\n" if $Debug; + + spawn sub { #child + warn "[child-$$] reading packet from local client" if $Debug > 1; + my $packet = fd_retrieve(\*Client); + warn "[child-$$] packet received:\n". + join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + if $Debug > 2; + my $command = $packet->{'command'}; + #handle some commands weirdly? + $packet->{_token}=$$; + + warn "[child-$$] sending packet to remote server" if $Debug > 1; + flock(STDOUT, LOCK_EX) or die "FATAL: can't lock write stream: $!"; + nstore_fd($packet, \*STDOUT) or die "FATAL: can't send response: $!"; + STDOUT->flush or die "FATAL: can't flush: $!"; + flock(STDOUT, LOCK_UN) or die "FATAL: can't release write lock: $!"; + close STDOUT or die "FATAL: can't close write stream: $!"; #??! + + warn "[child-$$] waiting for response from parent" if $Debug > 1; + my $w = new IO::Select; + $w->add(\*STDIN); + until ( $w->can_read ) { + warn "[child-$$] WARNING: interrupted select: $!\n"; + } + my $rv = fd_retrieve(\*STDIN); + + #close STDIN; + + warn "[child-$$] sending response to local client" if $Debug > 1; + nstore_fd($rv, \*Client); + Client->flush or die "FATAL: can't flush to local client: $!"; + close Client or die "FATAL: can't close connection to local client: $!"; + + warn "[child-$$] child exiting" if $Debug > 1; + exit; + + }; #eo child + + #close Client; + + } else { + die "wtf? $handle"; + } + + } + +} + +sub reap_kids { + #warn "reaping kids\n"; + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + close $kids{$kid}; + delete $kids{$kid}; + } + } + #warn "done reaping\n"; +} + +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, '|-'))) { + warn "WARNING: cannot fork: $!"; + return; + } elsif ($pid) { + warn "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 { + chomp( my $msg = shift ); + my $log = new IO::File ">>$log_file"; + flock($log, LOCK_EX); + seek($log, 0, 2); + print $log "[client] [". scalar(localtime). "] [$$] $msg\n"; + flock($log, LOCK_UN); + close $log; +} 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..e55ca4984 --- /dev/null +++ b/fs_selfservice/freeside-selfservice-server @@ -0,0 +1,224 @@ +#!/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( $Debug %kids $kids $max_kids $shutdown $log_file $ssh_pid ); +use Fcntl qw(:flock); +use POSIX qw(:sys_wait_h setsid); +use IO::Handle; +use IO::Select; +use IO::File; +use Storable qw(nstore_fd fd_retrieve); +use Net::SSH qw(sshopen2); +use FS::UID qw(adminsuidsetup forksuidsetup); +use FS::ClientAPI; + +$Debug = 2; # >= 2 will log packet contents, including potentially compromising + # information + +$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 $warnkids=0; +while (1) { + my($writer,$reader,$error) = (new IO::Handle, new IO::Handle, new IO::Handle); + warn "connecting to $machine\n" if $Debug; + + $ssh_pid = sshopen2($machine,$reader,$writer,$clientd); + +# nstore_fd(\*writer, {'hi'=>'there'}); + + warn "entering main loop\n" if $Debug; + my $undisp = 0; + my $s = IO::Select->new( $reader ); + while (1) { + + &reap_kids; + + warn "waiting for packet from client\n" if $Debug && !$undisp; + $undisp = 1; + my @handles = $s->can_read(5); + unless ( @handles ) { + &shutdown if $shutdown; + next; + } + + $undisp = 0; + + warn "receiving packet from client\n" if $Debug; + + my $packet = fd_retrieve($reader); + warn "packet received\n". + join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + if $Debug > 1; + + #prevent runaway forking + my $warnkids = 0; + while ( $kids >= $max_kids ) { + warn "WARNING: maximum $kids children reached\n" unless $warnkids++; + &reap_kids; + sleep 1; + } + + warn "forking child\n" if $Debug; + defined( my $pid = fork ) or die "can't fork: $!"; + if ( $pid ) { + $kids++; + $kids{$pid} = 1; + warn "child $pid spawned\n" if $Debug; + } else { #kid time + + #get new db handle + $FS::UID::dbh->{InactiveDestroy} = 1; + forksuidsetup($user); + + my $type = $packet->{_packet}; + warn "calling $type handler\n" if $Debug; + my $rv = eval { FS::ClientAPI->dispatch($type, $packet); }; + if ( $@ ) { + warn my $error = "WARNING: error dispatching $type: $@"; + $rv = { _error => $error }; + } + $rv->{_token} = $packet->{_token}; #identifier + + warn "sending response\n" if $Debug; + flock($writer, LOCK_EX) or die "FATAL: can't lock write stream: $!"; + nstore_fd($rv, $writer) or die "FATAL: can't send response: $!"; + $writer->flush or die "FATAL: can't flush: $!"; + flock($writer, LOCK_UN) or die "WARNING: can't release write lock: $!"; + + warn "child exiting\n" if $Debug; + exit; #end-of-kid + } + + } + +} + +### +# utility subroutines +### + +sub reap_kids { + #warn "reaping kids\n"; + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $kids--; + delete $kids{$kid}; + } + } + #warn "done reaping\n"; +} + +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--; } +# #sub REAPER { my $pid = wait; $kids--; $SIG{CHLD} = \&REAPER; } +# $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++; }; + + #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; + + #$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 > 0 && $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 ); + _do_logmsg( "[server] [". scalar(localtime). "] [$$] $msg\n" ); +} + +sub _do_logmsg { + chomp( my $msg = shift ); + my $log = new IO::File ">>$log_file"; + flock($log, LOCK_EX); + seek($log, 0, 2); + print $log "$msg\n"; + flock($log, LOCK_UN); + close $log; +} + +sub usage { + die "Usage:\n\n fs_signup_server user machine\n"; +} + diff --git a/fs_selfservice/fs_passwd_test b/fs_selfservice/fs_passwd_test new file mode 100755 index 000000000..4f8b8a888 --- /dev/null +++ b/fs_selfservice/fs_passwd_test @@ -0,0 +1,19 @@ +#!/usr/bin/perl -w + +use strict; +use FS::SelfService qw(passwd); + +my $rv = passwd( + 'username' => 'ivan', + 'old_password' => 'heyhoo', + 'new_password' => 'haloo', +); +my $error = $rv->{error}; + +if ( $error eq 'Incorrect password.' ) { + exit; +} else { + die $error if $error; + die "no error"; +} + |