Changeset 18511 for misc/runpugs
- Timestamp:
- 10/20/07 23:21:08 (13 months ago)
- Location:
- misc/runpugs/lib
- Files:
-
- 4 modified
-
Repl.pm (modified) (1 diff)
-
Web/Terminal/Dispatcher.pm (modified) (3 diffs)
-
Web/Terminal/Server.pm (modified) (8 diffs)
-
Web/Terminal/Server/Session.pm (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
misc/runpugs/lib/Repl.pm
r16617 r18511 14 14 sub run { 15 15 my $s=shift; 16 16 my $nl=shift || ""; 17 17 print $s->motd,"\n",$s->prompt; 18 18 while (<STDIN>) { -
misc/runpugs/lib/Web/Terminal/Dispatcher.pm
r16595 r18511 8 8 9 9 # 10 # based on testmsg.pl from "Advanced Perl Programming"10 # Vaguely based on testmsg.pl from "Advanced Perl Programming" 11 11 # 12 12 use lib '.', '../..'; #to keep EPIC happy … … 21 21 DEFAULT => [], 22 22 ); 23 my $v = 1;#(1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 23 my $v = 24 1; #(1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 24 25 26 # send(id,ip,app,interactive,cmds) 27 # id is a unique identifier (string) 28 # ip is the client IP address (string) 29 # app is a small integer indicating the application to run 30 # interactive is a flag (1 or 0) indicating if the Server needs to run the app as an interactive session or single-shot 31 # cmds is the string of commands to be sent to the application 25 32 sub send { 26 33 my $id = shift; … … 31 38 my $host = $Web::Terminal::Settings::host; 32 39 my $port = $Web::Terminal::Settings::port; 33 my $cmd = $cmds; #'';40 my $cmd = $cmds; 34 41 35 42 #WV: We're using PUGS_SAFEMODE=1 instead 36 # if ($Web::Terminal::Settings::filter and 37 # $cmd=~/$Web::Terminal::Settings::filter_pattern/) { 38 # my $offending_command=$1||$2; 39 # return "Sorry, \'$offending_command\' is not 40 # allowed.\n$Web::Terminal::Settings::prompt"; 41 # } else { 42 my $conn; 43 $conn = Web::Terminal::Msg->connect( $host, $port, \&rcvd_msg_from_server ); 44 if ( not $conn ) { 43 # But for applications without safe mode, we need this 44 if ( $Web::Terminal::Settings::filter 45 and $cmd =~ /$Web::Terminal::Settings::filter_pattern/ ) 46 { 47 my $offending_command = $1 || $2; 48 return "Sorry, \'$offending_command\' is not 49 allowed.\n$Web::Terminal::Settings::prompt"; 50 } else { 51 my $conn; 52 $conn = 53 Web::Terminal::Msg->connect( $host, $port, \&rcvd_msg_from_server ); 54 if ( not $conn ) { 45 55 46 #WV: disabled, too dangerous 47 # system("/usr/bin/perl ../bin/termserv.pl"); 48 # sleep 5; 49 # } else {last;} 50 return "Sorry, the pugs server is not running."; 51 } else { 52 my $msg = YAML::Syck::Dump( 53 { 54 id => $id, 55 ip => $ip, 56 app => $app, 57 ia => $interactive, 58 cmd => $cmd 59 } 60 ); 61 print STDERR "Sending message to server: $msg\n", '#' x 70, "\n" if $v; 62 $conn->send_now($msg); 63 print STDERR "done\n" if $v; 64 ( my $rmesg, my $err ) = $conn->rcv_now(); 65 print STDERR "Received reply from server: $rmesg (Error msg:$err)\n", 66 '#' x 70, "\n" if $v; 67 my $rmesgref = YAML::Syck::Load($rmesg); 68 my $rid = $rmesgref->{id}; 69 my $reply = $rmesgref->{msg}; 70 my $histref = $rmesgref->{recent}; 71 my $prompt = $rmesgref->{prompt}; 72 $conn->disconnect(); 56 #WV: disabled, too dangerous 57 # system("/usr/bin/perl ../bin/termserv.pl"); 58 # sleep 5; 59 # } else {last;} 60 return "Sorry, the pugs server is not running."; 61 } else { # Create the YAML-encoded message to be sent to the Server 62 my $msg = YAML::Syck::Dump( 63 { 64 id => $id, 65 ip => $ip, 66 app => $app, 67 ia => $interactive, 68 cmd => $cmd 69 } 70 ); 71 print STDERR "Sending message to server: $msg\n", '#' x 70, "\n" 72 if $v; 73 # Send it 74 $conn->send_now($msg); 75 print STDERR "done\n" if $v; 76 # Wait for reply 77 ( my $rmesg, my $err ) = $conn->rcv_now(); 78 print STDERR 79 "Received reply from server: $rmesg (Error msg:$err)\n", '#' x 70, 80 "\n" 81 if $v; 82 # Decode reply 83 my $rmesgref = YAML::Syck::Load($rmesg); 84 my $rid = $rmesgref->{id}; 85 my $reply = $rmesgref->{msg}; 86 my $histref = $rmesgref->{recent}; 87 my $prompt = $rmesgref->{prompt}; 88 # Tear down TCP connection 89 $conn->disconnect(); 73 90 74 if ( "$id" ne "$rid" ) { 75 print "Terminal server returned wrong id: $rid, should be $id" if $v; 76 return "Sorry, the pugs session died."; 91 if ( "$id" ne "$rid" ) { 92 print "Terminal server returned wrong id: $rid, should be $id" 93 if $v; 94 return "Sorry, the pugs session died."; 95 } 96 # The next bit is purely for testing 97 if ( $Web::Terminal::Settings::test == 1 98 and $cmd ne ':A' 99 and $cmd ne ':q' 100 and $cmd !~ /Web::Terminal/ ) 101 { 102 my $cmdreply = $reply; 103 $cmdreply =~ s/^.*?called\ with\ //; 104 $cmdreply =~ s/\.\s*$//; 105 if ( $cmdreply ne $cmd and $cmd != 1 ) { 106 print "D: Application returned '$reply'<>'$cmd':", 107 ( $reply eq '0' ), "<>", ( $reply == 0 ), ';', $rmesg, 108 "\n"; 109 } 110 } elsif ( $Web::Terminal::Settings::test == 1 and $cmd eq ':A' ) { 111 print "D: Simulated Abort. Application returned '$reply'\n" 112 if $v; 113 } # end of testing stuff 114 return ( $reply, $prompt, $histref ); 77 115 } 78 if($Web::Terminal::Settings::test==1 and $cmd ne ':A' and $cmd ne ':q' and $cmd!~/Web::Terminal/) {79 my $cmdreply=$reply;80 $cmdreply=~s/^.*?called\ with\ //;81 $cmdreply=~s/\.\s*$//;82 if($cmdreply ne $cmd and $cmd!=1 ) {83 print "D: Application returned '$reply'<>'$cmd':",($reply eq '0'),"<>",($reply==0),';',$rmesg,"\n";84 }85 } elsif ($Web::Terminal::Settings::test==1 and $cmd eq ':A') {86 print "D: Simulated Abort. Application returned '$reply'\n" if $v;87 }88 return ( $reply, $prompt, $histref );89 116 } 90 } 117 } # END of send() 91 118 92 119 sub rcvd_msg_from_server { -
misc/runpugs/lib/Web/Terminal/Server.pm
r16595 r18511 1 1 package Web::Terminal::Server; 2 3 #The inactive sessions queue starts with n_inactive_max sessions.4 #Ideally, once it drops to n_inactive_min, it should gradually create5 #n_inactive_max-n_inactive_min sessions6 #To do this reallu asynchronously, we need to let the child handle this7 #The problem is that the child can't access the counters of the parent.8 #So I'd just have the child create n_inactive_max-n_inactive_min sessions, gradually e.g. one every 5 minutes9 #But that might interfere with the cleanup:10 #The child sleeps for some time, then cleans up11 #So if we use the same time constant (makes sense),12 #the we need a counter which is set by the signal, that's all13 #So child gets a SIGUSR14 #=> it sets n_new_sessions to max-min if n_new_sessions was 015 2 16 3 use vars qw( $VERSION ); 17 4 $VERSION = '0.4.0'; 18 # 5 #use utf8; # No UTF, sorry 19 6 use strict; 20 7 use Carp::Assert; … … 39 26 # The messages contain the session id and the app. 40 27 # If the ID does not exist in %active_sessions, create a new session 41 # Otherwise, write to the terminal and send back the result, again42 # with the session id as first line.28 # Otherwise, write to the terminal and send back the result, 29 # again with the session id as first line. 43 30 44 31 # verbose 45 32 my $v = 1;#(1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 46 33 47 # Datastructures per app, so $session {$app}{...}, $inactive[$app][...] or @{$inactive[$app]}48 my @active_sessions = (); # id => session_numberfor active sessions49 my @sessions = (); # session_number (from stack) => actual session object50 my @session_numbers_stack = (); 51 my @inactive_sessions = (); # =>stack of session numbers for inactive sessions34 # Datastructures per app, so $sessions[$app]{...}, $inactive[$app][...] or @{$inactive[$app]} 35 my @active_sessions = (); # {id => session_number} for active sessions 36 my @sessions = (); # {session_number => actual session object} 37 my @session_numbers_stack = (); # stack for session numbers, i.e. those not active or inactive! 38 my @inactive_sessions = (); # stack of session numbers for inactive sessions 52 39 53 40 # Counters. 54 41 # initialised via init_sessions() 55 my @n_sessions = (); 42 my @n_sessions = (); # total number of sessions 56 43 my @n_active_sessions = (); 57 44 my @n_inactive_sessions = (); … … 92 79 if ( $childpid = fork ) { 93 80 94 #parent here 81 # Parent here 82 # Open log 95 83 my $log = 96 84 "$Web::Terminal::Settings::log_path/$Web::Terminal::Settings::appname.log"; … … 98 86 rename $log, $log . '.' . join( "", localtime ); 99 87 } 100 open( LOG2, ">$log" ); 88 open( LOG, ">$log" ); 89 101 90 print "Parent: init sessions ...\n " if $v; 102 91 &init_sessions(); 92 103 93 print "Parent: create new server..." if $v; 104 94 Web::Terminal::Msg->new_server( $host, $port, \&login_proc ); 105 95 print "OK\n" if $v; 96 97 # Wait for messages 106 98 Web::Terminal::Msg->event_loop(); 107 99 } elsif ( defined $childpid ) { 108 100 109 # child here101 # Child here 110 102 &init_child(); 111 103 … … 121 113 # The child can restart the parent 122 114 if ($Web::Terminal::Settings::test==1) { 123 die "No restarting, test phase\n";115 die "No restarting, test phase\n"; 124 116 } elsif ($Web::Terminal::Settings::restart_parent==1) { 125 print "Restarting server\n" if $v; 126 chdir $Web::Terminal::Settings::lib_path; 127 exec("$Web::Terminal::Settings::perl $Web::Terminal::Settings::server" 128 ); 117 print "Restarting server\n" if $v; 118 chdir $Web::Terminal::Settings::lib_path; 119 exec("$Web::Terminal::Settings::perl $Web::Terminal::Settings::server" 120 ); 121 } else { 122 die "Server died, please restart manually.\n"; 129 123 } 130 124 } elsif ( $! == EAGAIN ) { … … 193 187 my $term = $sessions[$app]{ $active_sessions[$app]{$id} }; 194 188 $tpid = $term->{pid}; 195 print LOG 2scalar(localtime),189 print LOG scalar(localtime), 196 190 " : $n_sess/$n_active_sess : $ip : $id : $tpid > ", $cmd, 197 191 "\n"; … … 434 428 } 435 429 } else { # max for ip reached 436 print LOG 2"MAX nsessions for $ip reached\n";430 print LOG "MAX nsessions for $ip reached\n"; 437 431 print "MAX nsessions for $ip reached\n" if $v; 438 432 return … … 647 641 &kill_session( $app, $id, $ip ); 648 642 #} 649 print LOG 2"Cleaned up $ip : $id : $tpid\n";643 print LOG "Cleaned up $ip : $id : $tpid\n"; 650 644 print "Cleaned up $ip : $id : $tpid\n" if $v; 651 645 } -
misc/runpugs/lib/Web/Terminal/Server/Session.pm
r16617 r18511 2 2 3 3 use vars qw( $VERSION ); 4 $VERSION='0. 3.0';4 $VERSION='0.4.0'; 5 5 use Moose; 6 #use strict; 7 #use utf8; 6 #use utf8; # Sorry, no UTF. Somebofy fix me Net::Telnet 8 7 use lib '.','../../..'; 9 8 use Web::Terminal::Settings; 10 9 11 # A thin wrapper around Net::Telnet12 # new() starts the session;13 # write() sends commands to it.10 # A thin wrapper around Net::Telnet 11 # new() starts the session; 12 # write() sends commands to it. 14 13 15 14 $SIG{CHLD}='IGNORE';
