Changeset 14374 for misc/runpugs

Timestamp:

10/17/06 08:26:47 (2 years ago)

Author:

andara

svk:copy_cache_prev:

21206

Message:

[runpugs]
Now catches Unicode & apologises :-)

Location:

misc/runpugs

Files:

• bin/termserv2.pl (modified) (1 diff)
• cgi-bin/runpugs (modified) (1 diff)
• htdocs/index.html (modified) (1 diff)
• lib/Web/Terminal/Server.pm (modified) (5 diffs)
• lib/Web/Terminal/Server/Session.pm (modified) (6 diffs)

misc/runpugs/bin/termserv2.pl

@@ -1 +1 @@
 #!/usr/bin/perl
+BEGIN {
+$ENV{PERLIO}= ":utf8";
+}
 use warnings;
 use strict;
 use utf8;
+
 use lib '../lib/';
 use Web::Terminal::Server;

misc/runpugs/cgi-bin/runpugs

@@ -100 +100 @@
     } else {
     $cmd=~s/^.+?pugs([\>\.])/pugs$1/s;
-    if ($cmd=~/clear/) {$cmd=''} else {
+    #NO UNICODE!
+#    $cmd=tr/\0-\x{10ffff}/\0-\xff_/;
+    if ($cmd=~/clear/) {$cmd=''} elsif ($cmd!~/^\p{IsASCII}*$/) {
+            $cmd='';
+                $reply = "Sorry, Unicode is not yet supported.\npugs> ";
+    } else {
     $reply = &WebTerminal::Dispatcher::send($sessionid,$ip,$cmd);
     $reply="\n".$reply;

misc/runpugs/htdocs/index.html

@@ -21 +21 @@
 
 <ul>
-<li><The code>pugs</code> shell runs in <em>safe mode</em>, so system-related calls (including <code>say()</code>!) are disabled.</li>
+<li><The code>pugs</code> shell runs in <em>safe mode</em>, so system-related calls are disabled.</li>
 <li>If a call takes too long, the <code>pugs</code> session will time out.</li>
 <li>If left idle for too long, the <code>pugs</code> session will time out.</li>

misc/runpugs/lib/Web/Terminal/Server.pm

@@ -32 +32 @@
 
 our %terminals=();
-our %lastcalled=();
+#our %lastcalled=();
 our %sessions_per_ip=();
 
@@ -39 +39 @@
     my $ip=shift;
         my $cmd = shift;
-if(scalar(keys %lastcalled)>$Web::Terminal::Settings::nsessions){ # each pugs takes 1% of feather's MEM!
+if(scalar(keys %terminals)>$Web::Terminal::Settings::nsessions){ # each pugs takes 1% of feather's MEM!
     return "Sorry, I can't run any more sessions.\nPlease try again later.";
 } else {
-        $lastcalled{$id}=time;
+#       $lastcalled{$id}=time;
         if ( exists $terminals{$id} ) {
+    $terminals{$id}->{called}=time;
                 my $term  = $terminals{$id};
                 my $lines = $term->write($cmd);
                 if ( $cmd eq $Web::Terminal::Settings::quit_command ) {
                         delete $terminals{$id};
-            delete $lastcalled{$id};
             $sessions_per_ip{$ip}--;
                 }
         if ($lines=~/Aborted/s) {
              delete $terminals{$id};
-             delete $lastcalled{$id};
             $sessions_per_ip{$ip}--;
         }
@@ -64 +63 @@
         } else {
             $sessions_per_ip{$ip}++;
-                $terminals{$id} = new Web::Terminal::Server:Session();
+                $terminals{$id} = new Web::Terminal::Server::Session();
+    $terminals{$id}->{called}=time;
+    $terminals{$id}->{ip}=$ip;
                 my $term = $terminals{$id};
                 return $term->{'init'};
@@ -78 +79 @@
                 if ( $len > 0 ) {
 #                       ( my $id, my $ip, my $cmd ) = split( "\n", $msg, 3 );
-print "MSG:", $msg;                     
+            print "MSG:", $msg;                 
                         my $mesgref=YAML::Syck::Load($msg);
                          my $id=$mesgref->{id};
              my $ip=$mesgref->{ip};
              my $cmd=$mesgref->{cmd};
-            $cmd=pack("U0C*", unpack("C*",$cmd));
+#            $cmd=pack("U0C*", unpack("C*",$cmd));
 #            print "$id($ip): ",$cmd,"\n";
                         my $lines = &termhandler( $id, $ip, $cmd );
@@ -132 +133 @@
 sub timeout() {
     my $now=time();
-    for my $id (keys %lastcalled) {
-        my $then=$lastcalled{$id};
+    for my $id (keys %terminals) {
+        my $then=$terminals{$id};
         if ($now-$then>$Web::Terminal::Settings::timeout_idle) {
         if(exists $terminals{$id}) {
+            my $ip=$terminals{$id}->{ip};
+            $sessions_per_ip{$ip}--;
             $terminals{$id}->write(':q');
             delete $terminals{$id};
-            }
-            if (exists $lastcalled{$id}) {
-            delete $lastcalled{$id};
             }
         }

misc/runpugs/lib/Web/Terminal/Server/Session.pm

@@ -47 +47 @@
         my $obj = shift;
         my $cmd  = shift;
-        chomp $cmd;
+#       print "CMD1: $cmd\n";
+#    $cmd=pack("U0C*", unpack("C*",$cmd));    
+#       print "CMD2: $cmd\n";
+    chomp $cmd;
         my $ps = '';
 
@@ -66 +69 @@
 #           print "L:",$line,":",$msg;
             if($msg=~/timed/) {
-        $msg='';
-        $pugs->errmsg([]);
-        $lline="${Web::Terminal::Settings::prompt} Sorry, that took too long! Aborted.\n";
-        $ps=$Web::Terminal::Settings::prompt;
-        last;
+            $msg='';
+            $pugs->errmsg([]);
+            $lline="${Web::Terminal::Settings::prompt} Sorry, that took too long! Aborted.\n";
+            $ps=$Web::Terminal::Settings::prompt;
+            last;
         }
         $msg='';
@@ -80 +83 @@
         }
 
-
         #$lline .= "\n$ps>";
+    chomp $ps; # a hack!
         $lline .= $ps;
         return $lline;
@@ -94 +97 @@
         $pty = new IO::Pty
           or die $!;
-    binmode $pty, ':utf8';
+    binmode $pty, ":utf8"; 
         ## Execute the program in another process.
         unless ( $pid = fork ) {    # child process
@@ -106 +109 @@
                 ## Associate process with a new controlling terminal.
                 $tty    = $pty->slave;
-        binmode $tty, ':utf8';
+        binmode $tty, ":utf8";
                 $tty_fd = $tty->fileno;
                 close $pty;
@@ -114 +117 @@
                 open STDOUT, ">&$tty_fd" or die $!;
                 open STDERR, ">&STDOUT"  or die $!;
+        binmode STDIN, ":utf8";
+        binmode STDOUT, ":utf8";
+        binmode STDERR, ":utf8";
                 close $tty;