Changeset 15408
- Timestamp:
- 03/02/07 17:08:05 (21 months ago)
- Location:
- misc/runpugs
- Files:
-
- 21 added
- 13 modified
-
LICENSE (added)
-
README (modified) (1 diff)
-
bin/multi_client_model.pl (added)
-
bin/termserv4.pl (added)
-
cgi-bin/runpugs (modified) (3 diffs)
-
cgi-perl/runp6script (added)
-
cgi-perl/runpugs (modified) (2 diffs)
-
data/runp6script.html (modified) (2 diffs)
-
data/runpugs.html (modified) (1 diff)
-
data/runpugs_cgi_bin.html (added)
-
data/runpugs_cgi_perl.html (added)
-
htdocs/runpugs/docs.html (modified) (1 diff)
-
htdocs/runpugs/index.html (modified) (1 diff)
-
lib/Web/Terminal/Dispatcher.pm (modified) (1 diff)
-
lib/Web/Terminal/Server.pm (modified) (2 diffs)
-
lib/Web/Terminal/Server/Session.pm (modified) (10 diffs)
-
lib/Web/Terminal/Server2.pm (added)
-
lib/Web/Terminal/Server3.pm (modified) (1 diff)
-
lib/Web/Terminal/Settings.pm (modified) (8 diffs)
-
lib6 (added)
-
lib6/README (added)
-
lib6/Web (added)
-
lib6/Web/Terminal (added)
-
lib6/Web/Terminal.pod (added)
-
lib6/Web/Terminal/Dispatcher.pm (added)
-
lib6/Web/Terminal/Dispatcher3.pm (added)
-
lib6/Web/Terminal/Msg.pm (added)
-
lib6/Web/Terminal/Server (added)
-
lib6/Web/Terminal/Server.pm (added)
-
lib6/Web/Terminal/Server/Session.pm (added)
-
lib6/Web/Terminal/Server3.pm (added)
-
lib6/Web/Terminal/Server4.pm (added)
-
lib6/Web/Terminal/Settings.pm (added)
-
perl/runpugs.pl (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
misc/runpugs/README
r15027 r15408 16 16 DESCRIPTION 17 17 runpugs has two main components: 18 -a mod_perl script (/perl/runpugs3 ) which uses an html template18 -a mod_perl script (/perl/runpugs3.pl) which uses an html template 19 19 (/data/runpugs_async3.html). The latter calls the runpugs.css stylesheet from 20 20 /htdocs/runpugs.css. The script is called from /htdocs/runpugs/index.html -
misc/runpugs/cgi-bin/runpugs
r14885 r15408 52 52 <tt>runpugs</tt>, now with AJAX and mod_perl.</p> 53 53 '; 54 #or <a55 #href="http://feather.perl6.nl:8080/cgi-bin/runpugs2?ia=0">run a full Perl 656 #script</a>.</p>57 #';58 54 59 55 } … … 203 199 $replyw.=$nprompt; 204 200 } 205 open(HTML,"<../data/runpugs 2.html");201 open(HTML,"<../data/runpugs_cgi_bin.html"); 206 202 while(<HTML>) { 207 203 /_HIST_/ && do { … … 266 262 ($reply=~/^\s*$/) && ($nrows=1); 267 263 if ($nrows>20) {$nrows=20;} 268 open(HTML,"<../data/runp ugs2s.html");264 open(HTML,"<../data/runp6script.html"); 269 265 while(<HTML>) { 270 266 s/_DEV_/$devc/; -
misc/runpugs/cgi-perl/runpugs
r14885 r15408 192 192 $replyw.=$nprompt; 193 193 } 194 open(HTML,"<../data/runpugs .html");194 open(HTML,"<../data/runpugs_cgi_perl.html"); 195 195 while(<HTML>) { 196 196 /_HIST_/ && do { … … 251 251 ($reply=~/^\s*$/) && ($nrows=1); 252 252 if ($nrows>20) {$nrows=20;} 253 open(HTML,"<../data/runp ugs2s.html");253 open(HTML,"<../data/runp6script.html"); 254 254 while(<HTML>) { 255 255 s/_DEV_/$devc/; -
misc/runpugs/data/runp6script.html
r15377 r15408 52 52 <!-- 53 53 <p>This live web terminal runs the <a href="http://www.pugscode.org">pugs</a> interpreter for <a 54 href="http://dev.perl.org/perl 6/">Perl 6</a>. For more details, read the <a54 href="http://dev.perl.org/perl 6/">Perl 6</a>. For more details, read the <a 55 55 href="http://feather.perl6.nl/~andara/runpugs/">info page</a>. 56 56 </p> … … 101 101 <p>This live web interface runs the <a href="http://www.pugscode.org">Pugs</a> 102 102 interpreter for <a 103 href="http://dev.perl.org/perl 6/">Perl 6</a>. Please <a103 href="http://dev.perl.org/perl 6/">Perl 6</a>. Please <a 104 104 href="http://feather.perl6.nl/~andara/runpugs/">read the documentation</a>. 105 105 </p> -
misc/runpugs/data/runpugs.html
r14954 r15408 3 3 <head> 4 4 <meta http-equiv="Content-Type" content="text/html; charset=utf-8"> 5 6 <title>Run Perl 6 Now -- in your browser!</title>7 <link rel="stylesheet" type="text/css" href="/runpugs.css">8 <script language="JavaScript">9 var nchars=0;10 function getnchars() {11 return document.terminal.cmd.value.length12 }13 14 function getcursorpos() {15 var obj=document.terminal.cmd;16 if(document.selection) {17 obj.focus();18 var rng=document.selection.createRange();19 rng.moveStart('character',-nchars);20 return rng.text.length;21 } else if(obj.selectionStart>=0) { // FireFox22 var start = obj.selectionStart;23 var end = obj.selectionEnd;24 if (start<=end) {25 return start;26 } else {27 return end;28 }29 }30 }31 32 function catchbackspace(myfield,e)33 {34 var keycode;35 if (window.event) {keycode = window.event.keyCode;36 }37 else if (e) {38 keycode = e.which;39 }40 else return true;41 42 if (keycode == 13)43 {44 document.terminal.submit();45 return false;46 }47 if (keycode==38) {48 return false;49 }50 if ((keycode==8)||(keycode==37)||(keycode==46)) {51 if ((getnchars()>nchars) && (getcursorpos() > nchars)) {52 return true;53 } else {54 return false;55 }56 } else {57 return true;58 }59 }60 61 // onkeypress="return catchbackspace(this,event)" onkeydown="return catchbackspace(this,event)"62 function submitenter(myfield,e)63 {64 var keycode;65 if (window.event) keycode = window.event.keyCode;66 else if (e) keycode = e.which;67 else return true;68 if (keycode == 13)69 {70 document.terminal.submit();71 return false;72 }73 else {74 if (keycode == 8) {75 if (getnchars()>nchars) {76 return true;77 } else {78 return false;79 }80 } else {81 return true;82 }83 }84 }85 86 function select_enter()87 {88 /* _SKIPC_89 document.terminal.cmdline.value=document.terminal.hist.options[document.terminal.hist.selectedIndex].value;90 document.terminal.hist.selectedIndex=0;91 document.terminal.cmdline.focus();92 _SKIPC_ */93 /* _SKIPT_94 document.terminal.cmd.value+=document.terminal.hist.options[document.terminal.hist.selectedIndex].value;95 document.terminal.hist.selectedIndex=0;96 document.terminal.cmd.focus();97 document.terminal.cmd.scrollTop =document.terminal.cmd.scrollHeight;98 _SKIPT_ */99 }100 101 function select_enter_OFF(myfield,e)102 {103 var keycode;104 if (window.event) keycode = window.event.keyCode;105 else if (e) keycode = e.which;106 else return true;107 if (keycode == 13)108 {109 document.terminal.cmdline.value=document.terminal.hist.options[document.terminal.hist.selectedIndex].value;110 return false;111 }112 else113 return true;114 }115 </script>116 5 </head> 117 6 <body> 118 <div id="mainwindow"> 119 <h1>Run Perl 6 now -- in your browser!</h1> 120 <form id="term" name="terminal" action="/cgi-perl/runpugs" method="POST"> 7 <form id="term" name="terminal" action="/perl/runpugs.pl" method="POST"> 121 8 <input type="hidden" name="prompt" value="_PROMPTW_"> 122 9 <input type="hidden" name="sessionid" value=""> 123 10 <input type="hidden" name="ia" value="1"> 124 11 <input type="hidden" name="action" value="runpugs"> 125 <input type="radio" id="rel" value="0" name="reldev" _REL_ ><label 126 for="rel">Release version</label> 127 <input type="radio" id="dev" value="1" name="reldev" _DEV_ ><label 128 for="dev">Development version</label> 129 <div id="termwindow"> 130 <select name="history" id="hist" onChange="select_enter()"> 12 <input type="radio" id="rel" value="0" name="reldev" _REL_ > 13 <input type="radio" id="dev" value="1" name="reldev" _DEV_ > 14 <select name="history" id="hist" > 131 15 <option value="">--- Recent commands ---</option> 132 16 _HIST_ 133 17 </select> 134 <br> 135 <!-- _SKIPT_ 136 <textarea id="cmd" name="cmd" rows="20" cols="80" wrap="virtual" onkeypress="return catchbackspace(this,event)" onkeydown="return catchbackspace(this,event)"> 18 <textarea id="cmd" name="cmd" rows="20" cols="80"> 137 19 _ALL_ 138 20 </textarea> 139 _SKIPT_ --> 140 <!--_SKIPC_ 141 <textarea readonly id="output" name="output" rows="_NROWS_" cols="80" wrap="virtual"> 142 _REPLYW_ 143 </textarea> 144 <br> 145 <label for="cmdline"><span class="prompt"> 146 _NPROMPTW_ 147 </span> 148 <input type="text" size="74" id="cmdline" name="cmdline" value="" 149 onKeyPress="return submitenter(this,event)"> 150 </label> 151 _SKIPC_ --> 152 </div> 153 <input id="enter" type="submit" value="Submit"> 21 <input id="enter" type="submit" value="Submit"> 154 22 </form> 155 <script language="JavaScript">156 document.terminal.enter.style.display='none';157 document.terminal.cmdline.focus() // _SKIPT_158 document.terminal.cmd.focus() // _SKIPC_159 document.terminal.output.scrollTop =document.terminal.output.scrollHeight; // _SKIPT_160 document.terminal.cmd.scrollTop =document.terminal.cmd.scrollHeight; // _SKIPC_161 //if (document.terminal.output.rows==1) {162 //document.terminal.output.style.height="2ex";163 //}164 nchars=document.terminal.cmd.value.length;165 </script>166 <p>This live web terminal runs the <a href="http://www.pugscode.org">pugs</a> interpreter for <a167 href="http://dev.perl.org/perl 6/">Perl 6</a>. Please <a168 href="http://feather.perl6.nl/~andara/runpugs/">read the documentation</a>.169 </p>170 <p class="copyright">© Copyright 2006 by Wim.Vanderbauwhede. Contact me171 at gmail.com.</p>172 </div>173 23 </body> 174 24 </html> -
misc/runpugs/htdocs/runpugs/docs.html
r15351 r15408 71 71 <h2>Source</h2> 72 72 <p>You can find the source code for <tt>runpugs</tt> (in Perl 5) in the <a 73 href="http://svn. pugscode.org/pugs/">pugs subversion repository</a> under74 <code><a href="http://svn. pugscode.org/pugs/misc/runpugs">/misc/runpugs</a></code>.73 href="http://svn.openfoundry.org/pugs/">pugs subversion repository</a> under 74 <code><a href="http://svn.openfoundry.org/pugs/misc/runpugs">/misc/runpugs</a></code>. 75 75 <p>Thank you for trying <tt>pugs</tt> and <tt>runpugs</tt>!</p> 76 76 <p class="copyright">© Copyright 2006 by Wim Vanderbauwhede</p> -
misc/runpugs/htdocs/runpugs/index.html
r15027 r15408 6 6 </head> 7 7 <body onunload="HandleOnUnload(event)"> 8 <iframe src="/perl/runpugs 3.pl" id="scratch" name="scratch"8 <iframe src="/perl/runpugs.pl" id="scratch" name="scratch" 9 9 style="visibility:hidden" width="700px" height="1px" onLoad="getreply()"></iframe> 10 10 <div id="mainwindow"> -
misc/runpugs/lib/Web/Terminal/Dispatcher.pm
r14885 r15408 1 package Web::Terminal::Dispatcher; 2 1 package Web::Terminal::Dispatcher3; 3 2 use vars qw( $VERSION ); 4 $VERSION = '0. 2.0';3 $VERSION = '0.3.0'; 5 4 use strict; 6 5 use utf8; 7 6 use YAML::Syck; 7 8 8 # 9 9 # based on testmsg.pl from "Advanced Perl Programming" 10 10 # 11 use lib '.', '../..'; #�o keep EPIC happy 11 12 use Web::Terminal::Settings; 12 13 use Web::Terminal::Msg; 13 14 use Exporter; 14 15 our @ISA = qw( Exporter ); 16 our @EXPORT = qw(send ); 17 our @EXPORT_OK = qw(send ); 15 our @ISA = qw( Exporter ); 16 our @EXPORT = qw(send ); 17 our @EXPORT_OK = qw(send ); 18 18 our %EXPORT_TAGS = ( 19 ALL => [qw( send )],20 DEFAULT => [],19 ALL => [qw( send )], 20 DEFAULT => [], 21 21 ); 22 my $v =1-$Web::Terminal::Settings::daemon;22 my $v = (1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 23 23 24 24 sub send { 25 my $id = shift; 26 my $ip = shift; 27 my $app=shift; 28 my $interactive=shift; 29 my $cmds = shift; 30 my $host = $Web::Terminal::Settings::host; 31 my $port = $Web::Terminal::Settings::port; 32 my $cmd=$cmds;#''; 33 =old 34 # we only consider the last line with a prompt 35 my @cmdlines=split("\n",$cmds); 36 for my $cmdline (reverse @cmdlines) { 37 $cmdline=~/^\s*$/ && next; 38 #$cmdline=~/^(pugs|\.\.\.\.)\>\s+/ && do { 39 $cmdline=~/$Web::Terminal::Settings::prompt_pattern/ && do { 40 $cmd=$cmdline; 41 #$cmd=~s/^(pugs|\.\.\.\.)\>\s+//; 42 $cmd=~s/$Web::Terminal::Settings::prompt_pattern//; 43 chomp $cmd; 44 last; 45 }; 46 } 47 =cut 48 49 # We're using PUGS_SAFEMODE=1 instead 50 # if ($Web::Terminal::Settings::filter and 51 # $cmd=~/$Web::Terminal::Settings::filter_pattern/) { 52 # if ($cmd=~/\b(system|exec|fork|wait|open|slurp|eval|kill)\b|(\`)/) { 53 # my $offending_command=$1||$2; 54 # return "Sorry, \'$offending_command\' is not allowed.\npugs> "; 55 # return "Sorry, \'$offending_command\' is not 56 # allowed.\n$Web::Terminal::Settings::prompt"; 57 # } else { 58 my $conn; 59 # my $ntries=5; 60 # for (1..$ntries) { 25 my $id = shift; 26 my $ip = shift; 27 my $app = shift; 28 my $interactive = shift; 29 my $cmds = shift; 30 my $host = $Web::Terminal::Settings::host; 31 my $port = $Web::Terminal::Settings::port; 32 my $cmd = $cmds; #''; 33 34 #WV: We're using PUGS_SAFEMODE=1 instead 35 # if ($Web::Terminal::Settings::filter and 36 # $cmd=~/$Web::Terminal::Settings::filter_pattern/) { 37 # my $offending_command=$1||$2; 38 # return "Sorry, \'$offending_command\' is not 39 # allowed.\n$Web::Terminal::Settings::prompt"; 40 # } else { 41 my $conn; 61 42 $conn = Web::Terminal::Msg->connect( $host, $port, \&rcvd_msg_from_server ); 62 # die "Client could not connect to $host:$port ($wd)\n" unless $conn; 63 if (not $conn) { 64 # # Assume server has died 65 #WV: disabled, too dangerous 66 # system("/usr/bin/perl ../bin/termserv.pl"); 67 # sleep 5; 68 # } else {last;} 69 return "Sorry, the pugs server is not running."; 70 } else { 71 my $msg = YAML::Syck::Dump({ id=> $id, ip=> $ip, app=>$app,ia=>$interactive,cmd=> $cmd}); 72 print STDERR "Sending message to server: $msg\n" if $v; 73 $conn->send_now($msg); 74 print STDERR "done\n" if $v; 75 ( my $rmesg, my $err ) = $conn->rcv_now(); 76 print STDERR "Received reply from server: $rmesg (Error msg:$err)\n" if $v; 77 # ( my $rid, my $reply ) = split( "\n", $rmesg, 2 ); 78 my $rmesgref= YAML::Syck::Load($rmesg); 79 my $rid=$rmesgref->{id}; 80 my $reply=$rmesgref->{msg}; 81 my $histref=$rmesgref->{recent}; 82 my $prompt=$rmesgref->{prompt}; 83 $conn->disconnect(); 84 if ( "$id" ne "$rid" ) { 85 # die "Terminal server returned wrong id: $rid, should be $id"; 86 return "Sorry, the pugs session died."; 43 if ( not $conn ) { 44 45 #WV: disabled, too dangerous 46 # system("/usr/bin/perl ../bin/termserv.pl"); 47 # sleep 5; 48 # } else {last;} 49 return "Sorry, the pugs server is not running."; 50 } else { 51 my $msg = YAML::Syck::Dump( 52 { 53 id => $id, 54 ip => $ip, 55 app => $app, 56 ia => $interactive, 57 cmd => $cmd 58 } 59 ); 60 print STDERR "Sending message to server: $msg\n", '#' x 70, "\n" if $v; 61 $conn->send_now($msg); 62 print STDERR "done\n" if $v; 63 ( my $rmesg, my $err ) = $conn->rcv_now(); 64 print STDERR "Received reply from server: $rmesg (Error msg:$err)\n", 65 '#' x 70, "\n" if $v; 66 my $rmesgref = YAML::Syck::Load($rmesg); 67 my $rid = $rmesgref->{id}; 68 my $reply = $rmesgref->{msg}; 69 my $histref = $rmesgref->{recent}; 70 my $prompt = $rmesgref->{prompt}; 71 $conn->disconnect(); 72 73 if ( "$id" ne "$rid" ) { 74 print "Terminal server returned wrong id: $rid, should be $id" if $v; 75 return "Sorry, the pugs session died."; 76 } 77 return ( $reply, $prompt, $histref ); 87 78 } 88 return ($reply,$prompt,$histref);89 }90 79 } 91 80 -
misc/runpugs/lib/Web/Terminal/Server.pm
r14930 r15408 1 package Web::Terminal::Server; 1 package Web::Terminal::Server4; 2 3 =pod 4 The inactive sessions queue starts with n_inactive_max sessions. 5 Ideally, once it drops to n_inactive_min, it should gradually create 6 n_inactive_max-n_inactive_min sessions 7 To do this reallu asynchronously, we need to let the child handle this 8 The problem is that the child can't access the counters of the parent. 9 So I'd just have the child create n_inactive_max-n_inactive_min sessions, gradually e.g. one every 5 minutes 10 But that might interfere with the cleanup: 11 The child sleeps for some time, then cleans up 12 So if we use the same time constant (makes sense), 13 the we need a counter which is set by the signal, that's all 14 15 16 So child gets a SIGUSR 17 => it sets n_new_sessions to max-min if n_new_sessions was 0 18 =cut 2 19 3 20 use vars qw( $VERSION ); 4 $VERSION = '0. 2.0';5 use utf8; 21 $VERSION = '0.4.0'; 22 # use utf8; # No UTF, sorry 6 23 use strict; 7 24 use Carp::Assert; 8 25 use YAML::Syck; 9 #use lib '.';10 11 26 use Proc::Daemon; 27 use lib '.','../..'; #�o keep EPIC happy 12 28 use Web::Terminal::Settings; 13 29 use Web::Terminal::Msg; 14 30 use Web::Terminal::Server::Session; 15 16 our @ISA = qw( Exporter ); 17 our @EXPORT = qw( run ); 18 our @EXPORT_OK = qw( run ); 31 our @ISA = qw( Exporter ); 32 our @EXPORT = qw( run ); 33 our @EXPORT_OK = qw( run ); 19 34 our %EXPORT_TAGS = ( 20 21 22 35 ALL => [qw( run )], 36 DEFAULT => [], 37 ); 23 38 24 39 #$|=1; 25 40 $SIG{CHLD} = 'IGNORE'; 26 41 27 # The messages contain the session id. 28 # If the ID does not exist in %terminals, create a new session 42 43 # The messages contain the session id and the app. 44 # If the ID does not exist in %active_sessions, create a new session 29 45 # Otherwise, write to the terminal and send back the result, again 30 46 # with the session id as first line. 31 47 32 our %terminals=(); 33 our %nsessions_per_ip=(); 34 35 my $v=1-$Web::Terminal::Settings::daemon; 36 48 # verbose 49 my $v = (1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 50 51 #my %sessions = (); # session_number (from stack) => actual session object 52 #Datastructures per app, so $session{$app}{...}, $inactive[$app][...] or @{$inactive[$app]} 53 my @active_sessions = (); # id => session_number for active sessions 54 my @sessions = (); # session_number (from stack) => actual session object 55 my @session_numbers_stack = (); # stack for session numbers, i.e. those not active or inactive! 56 my @inactive_sessions = (); # => stack of session numbers for inactive sessions 57 #my @unused = (); # => hash keyed by session number. value is id. 58 59 # Counters. 60 # initialised via init_sessions() 61 my @n_sessions = (); # total number of sessions 62 my @n_active_sessions = (); 63 my @n_inactive_sessions = (); 64 65 #�imit number of session from a single IP. 66 # Problem for folks behind a gateway, but otherwise too easy for DoS 67 my %n_sessions_ip = (); # ip -> nsessions 68 69 # for use by child to know how many new sessions to create 70 my @n_new_sessions = (); 71 72 # Limits 73 my @n_inactive_min = @Web::Terminal::Settings::n_inactive_min; 74 my @n_inactive_max = @Web::Terminal::Settings::n_inactive_max; 75 my @n_max = @Web::Terminal::Settings::n_max; 76 my $n_sessions_ip_max = $Web::Terminal::Settings::nsessions_ip; 77 78 # Child pid 79 my $childpid; 80 81 #------------------------------------------------------------------------------- 82 # The main method to be called on a server object. Does fork&exec and init + open log 83 sub run { 84 my $host = $Web::Terminal::Settings::host; 85 my $port = $Web::Terminal::Settings::port; 86 $SIG{USR1} = \&clean_up_timed_out_sessions; 87 $SIG{USR2} = \&init_create; 88 if ($Web::Terminal::Settings::daemon) { 89 Proc::Daemon::Init; 90 } 91 92 # fork/exec by the book: 93 use Errno qw(EAGAIN); 94 FORK: { 95 if ( $childpid = fork ) { 96 97 #parent here 98 my $log = 99 "$Web::Terminal::Settings::log_path/$Web::Terminal::Settings::appname.log"; 100 if ( -e $log ) { 101 rename $log, $log . '.' . join( "", localtime ); 102 } 103 open( LOG2, ">$log" ); 104 print "Parent: init sessions ...\n " if $v; 105 &init_sessions(); 106 print "Parent: create new server..." if $v; 107 Web::Terminal::Msg->new_server( $host, $port, \&login_proc ); 108 print "OK\n" if $v; 109 Web::Terminal::Msg->event_loop(); 110 } elsif ( defined $childpid ) { 111 112 # child here 113 &init_child(); 114 115 while ( getppid() > 10 ) { # a bit ad-hoc. to see if parent is alive 116 sleep $Web::Terminal::Settings::check_interval; 117 118 # print "Child: ", getppid(), "\n" if $v; 119 &call_create(); # can consume a lot of time! 120 &call_clean_up(); 121 #kill 'USR1', getppid(); 122 } 123 124 # normally the child restarts the parent if it dies 125 if ($Web::Terminal::Settings::test==1) { 126 die "No restarting, test phase\n"; 127 } elsif ($Web::Terminal::Settings::restart_parent==1) { 128 print "Restarting server\n" if $v; 129 chdir $Web::Terminal::Settings::lib_path; 130 exec("$Web::Terminal::Settings::perl $Web::Terminal::Settings::server" 131 ); 132 } 133 } elsif ( $! == EAGAIN ) { 134 135 # Maybe ulimit might take us here 136 sleep 30; 137 redo FORK; 138 } else { 139 140 # Or ulimit could take us here 141 print "Couldn't fork" if $v; 142 die "Can't fork: $!\n"; 143 } 144 } # FORK 145 } # END of run() 146 147 #------------------------------------------------------------------------------- 148 # If you wonder why this is here, read 149 # Advanced Perl Programming 150 sub login_proc { 151 152 # Unconditionally accept. 153 \&rcvd_msg_from_client; 154 } 155 156 #------------------------------------------------------------------------------- 157 # General request handler 158 # Valid messages are either session create request or requests from the web client 159 # Both types should be sent by Dispatcher::run() 160 # Or a compatible API :-) 161 sub rcvd_msg_from_client { 162 my ( $conn, $msg, $err ) = @_; 163 my $success=1; 164 if ( defined $msg ) { 165 # for my $key (keys( %{$conn}) ) { 166 # print $key,':',$conn->{$key},"\n"; 167 # if ($key eq 'queue') { 168 # print scalar