Changeset 14430 for misc/runpugs

Timestamp:

10/22/06 01:36:47 (2 years ago)

Author:

andara

Message:

[runpugs]
-improved error handling (try not to die).
-Web::Terminal: new generic version with command history, supports GHCi and
many more. (not live yet)

Location:

misc/runpugs

Files:

• bin/termdispatcher2.pl (modified) (1 diff)
• cgi-bin/runpugs (modified) (1 diff)
• cgi-bin/runpugs2 (added)
• data/runpugs2.html (added)
• htdocs/favicon.ico (added)
• htdocs/runpugs.css (modified) (3 diffs)
• lib/Web/Terminal/Dispatcher.pm (modified) (2 diffs)
• lib/Web/Terminal/Msg.pm (modified) (2 diffs)
• lib/Web/Terminal/Server.pm (modified) (7 diffs)
• lib/Web/Terminal/Server/Session.pm (modified) (10 diffs)
• lib/Web/Terminal/Settings.pm (modified) (2 diffs)
• lib/WebTerminal/Msg.pm (modified) (2 diffs)
• lib/WebTerminal/Server.pm (modified) (4 diffs)
• lib/WebTerminal/Server/Terminal.pm (modified) (6 diffs)

misc/runpugs/bin/termdispatcher2.pl

@@ -14 +14 @@
 my $cmd=$ARGV[1] || 'my $a='.$id.';say "Hello, $a";';
 #my $cmd='my $a='.$id.';say "Hello, $a";';
-my $prompt='pugs> ';
+#my $prompt='pugs> ';
+my $prompt='Prelude> ';
 print "Sending msg $id: $cmd\n";
 my $ip="127.0.0.1";
-my $reply = &Web::Terminal::Dispatcher::send($id,$ip,$prompt.$cmd);
+(my $reply,my $histref) = &Web::Terminal::Dispatcher::send($id,$ip,$prompt.$cmd);
 print $reply;
+print "\nHistory\n";
+for my $entry (@{$histref}) {
+print "\t$entry\n";
+}
 

misc/runpugs/cgi-bin/runpugs

@@ -102 +102 @@
     #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> ";
+    if ($cmd=~/clear/) {
+        $cmd='';
+    } elsif ($cmd!~/^\p{IsASCII}*$/) {
+        $cmd='';
+        $reply = "Sorry, Unicode is not yet supported.\npugs> ";
     } else {
+    if ($cmd=~/>\s+(\:*help)\b/) {
+        $cmd=~s/$1/:h/;
+    } elsif ($cmd=~/>\s+(\:*(quit|bye))\b/) {
+        $cmd=~s/$1/:q/;
+    } 
     $reply = &WebTerminal::Dispatcher::send($sessionid,$ip,$cmd);
     $reply="\n".$reply;

misc/runpugs/htdocs/runpugs.css

@@ -1 @@
-BODY {width:100%;margin-left:10%;margin-right:10%; margin-top: 10px; font-family: Verdana, Geneva, Arial, Helvetica, sans-serif; font-size: 11pt; line-height: normal; background-color:#FFFFFF;}
+BODY {width:100%;margin-left:10%;margin-right:10%; margin-top: 10px; font-family: Verdana, Geneva, Arial, Helvetica, sans-serif; font-size: 12pt; line-height: normal; background-color:#FFFFFF;}
 H1 {font-size: 24pt; 
     font-family: Georgia, Serif, Times; 
@@ -9 +9 @@
 H2 { font-weight: bold; font-size: 12pt}
 LABEL {font-weight: bold; }
-EM {font-weight: bold;
-    font-style: normal;
-    text-decoration:none;}
-TT {color: #204a87;
-font-weight: bold;
-}
 .copyright {font-size: 9pt}
 .warning {
@@ -22 +16 @@
 #mainwindow {
 width: 750px 
+}
+#hist {
+width: 750px;
+border: solid 2px #204a87;
+font-family: "Andale Mono", courier, fixed, monospace;
+font-size: 10pt;
+color: #204a87;
+    background-color: #f2f2f0;
+    padding-bottom: 5px;
 }
 #cmd {

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

@@ -28 +28 @@
         my $port = $Web::Terminal::Settings::port;
         my $cmd='';
-    # we only consider the last line witha prompt
+    # we only consider the last line with a prompt
         my @cmdlines=split("\n",$cmds);
         for my $cmdline (reverse @cmdlines) {
@@ -70 +70 @@
      my $rid=$rmesgref->{id};
       my $reply=$rmesgref->{msg};
+      my $histref=$rmesgref->{recent};
     $conn->disconnect();
         if ( "$id" ne  "$rid" ) {
-                die "Terminal server returned wrong id: $rid, should be $id";
+#               die "Terminal server returned wrong id: $rid, should be $id";
+        return "Sorry, the pugs session died.";
         }
-        return $reply;
+        return ($reply,$histref);
    }
 }

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

@@ -249 +249 @@
 sub _new_client {
     my $sock = $main_socket->accept();
+    #returns undef on fail. Calling peerhost on undef makes it die.
+    ## so:
+    if (defined $sock) {
+
     my $conn = bless {
         'sock' =>  $sock,
@@ -262 +266 @@
         $conn->disconnect();
     }
+    } else {
+        return undef;
+    }
 }
 

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

@@ -32 +32 @@
 
 our %terminals=();
-#our %lastcalled=();
 our %sessions_per_ip=();
 
@@ -42 +41 @@
     return "Sorry, I can't run any more sessions.\nPlease try again later.";
 } else {
-#       $lastcalled{$id}=time;
         if ( exists $terminals{$id} ) {
+    print "$id exists\n";
+    if ($terminals{$id}->{pid}) {    
     $terminals{$id}->{called}=time;
                 my $term  = $terminals{$id};
+        push  @{$term->{recent}},$cmd;
+        if (scalar @{$term->{recent}}> $Web::Terminal::Settings::nrecent) {
+            shift @{$term->{recent}};
+        }
                 my $lines = $term->write($cmd);
                 if ( $cmd eq $Web::Terminal::Settings::quit_command ) {
+            my $pid= $terminals{$id}->{pid};
+            print "Quit $id ($pid)\n";
                         delete $terminals{$id};
+            if ($pid) {
+                kill 9,$pid;
+            }
             $sessions_per_ip{$ip}--;
-                }
-        if ($lines=~/Aborted/s) {
+#               }
+        #if ($lines=~/Aborted/s) {
+        } elsif ($terminals{$id}->{error}==1) {
+             my $pid= $terminals{$id}->{pid};
              delete $terminals{$id};
+            if ($pid) {
+                kill 9,$pid;
+           }
             $sessions_per_ip{$ip}--;
         }
                 return $lines;
+        } else {
+            return "pugs> ";
+        }
         } else {
         if ($sessions_per_ip{$ip}>$Web::Terminal::Settings::nsessions_ip) {
-         return "Sorry, you can't run more than
-         ${Web::Terminal::Settings::nsessions_ip} sessions from one IP
-         address.\n";   
+        print LOG2 "MAX nsessions for $ip reached\n";
+         return "Sorry, you can't run more than ${Web::Terminal::Settings::nsessions_ip} sessions from one IP address.\n";   
         } else {
+        print "New $id\n";
             $sessions_per_ip{$ip}++;
-                $terminals{$id} = new Web::Terminal::Server::Session();
-    $terminals{$id}->{called}=time;
-    $terminals{$id}->{ip}=$ip;
-                my $term = $terminals{$id};
-                return $term->{'init'};
+                $terminals{$id} = new Web::Terminal::Server::Session();
+            $terminals{$id}->{called}=time;
+            $terminals{$id}->{ip}=$ip;
+                my $term = $terminals{$id};
+            my $init= $term->{'init'};
+            my $error= $term->{'error'};
+            if ($error==1) { # Failed to create a new terminal
+                $sessions_per_ip{$ip}--;
+                delete $terminals{$id};
+            }
+            return $init;
         }
         }
@@ -79 +102 @@
                 if ( $len > 0 ) {
 #                       ( my $id, my $ip, my $cmd ) = split( "\n", $msg, 3 );
-            print "MSG:", $msg;                 
                         my $mesgref=YAML::Syck::Load($msg);
-                         my $id=$mesgref->{id};
-             my $ip=$mesgref->{ip};
-             my $cmd=$mesgref->{cmd};
+                        my $id=$mesgref->{id};
+            my $ip=$mesgref->{ip};
+            my $cmd=$mesgref->{cmd};
 #            $cmd=pack("U0C*", unpack("C*",$cmd));
-#            print "$id($ip): ",$cmd,"\n";
+            my $pid=0;
+            if(exists $terminals{$id}) {
+                $pid=$terminals{$id}->{pid};
+            }
+            my $nsess=scalar keys %terminals;
+            print scalar(localtime)," : $nsess : $ip : $id : $pid > ",$cmd,"\n";
+            print LOG2 scalar(localtime)," : $nsess : $ip : $id : $pid > ",$cmd,"\n";
                         my $lines = &termhandler( $id, $ip, $cmd );
-            my $replyref=YAML::Syck::Dump({id=>$id,msg=>$lines});
-#                       $conn->send_now("$id\n$lines");
+            my @history=('--- Recent commands ---');
+            if (defined $terminals{$id}->{recent}) {
+             @history=@{$terminals{$id}->{recent}};
+            }
+            my
+            $replyref=YAML::Syck::Dump({id=>$id,msg=>$lines,recent=>\@history});
                         $conn->send_now($replyref);
 
@@ -105 +137 @@
 
 $SIG{USR1}=\&timeout;
-#Proc::Daemon::Init;
-
+if ( $Web::Terminal::Settings::daemon) {
+    Proc::Daemon::Init;
+}
 # fork/exec by the book:
 use Errno qw(EAGAIN);
@@ -113 +146 @@
 if ($pid=fork) {
     #parent here
+    if (-e "/home/andara/apache/data/runpugs2.log") {
+        rename "/home/andara/apache/data/runpugs2.log","/home/andara/apache/data/runpugs2.log.".join("",localtime);
+    }
+    open(LOG2,">/home/andara/apache/data/runpugs2.log");
     Web::Terminal::Msg->new_server( $host, $port, \&login_proc );
     Web::Terminal::Msg->event_loop();
@@ -122 +159 @@
         kill 'USR1',getppid();
     }
+    system("killall $Web::Terminal::Settings::command");
+    chdir $Web::Terminal::Settings::cgi_path;
+    exec("$Web::Terminal::Settings::perl ../bin/$Web::Terminal::Settings::server");
+#    chdir "/home/andara/apache/cgi-bin/";
+#    exec('/usr/bin/perl ../bin/termserv.pl');
 } elsif ($! == EAGAIN) {
     sleep 5;
@@ -134 +176 @@
     my $now=time();
     for my $id (keys %terminals) {
-        my $then=$terminals{$id};
+        my $then=$terminals{$id}->{called};
         if ($now-$then>$Web::Terminal::Settings::timeout_idle) {
         if(exists $terminals{$id}) {
+          my $pid= $terminals{$id}->{pid};
             my $ip=$terminals{$id}->{ip};
             $sessions_per_ip{$ip}--;
-            $terminals{$id}->write(':q');
+             if ($pid) {
+                kill 9,$pid;
+            }
+#            $terminals{$id}->write(':q');
             delete $terminals{$id};
+            print LOG2 "Cleaned up $ip : $id : $pid\n";
             }
         }

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

@@ -13 +13 @@
 =cut
 
+$SIG{CHLD}='IGNORE';
 ## Constructor
 sub new {
@@ -20 +21 @@
 #       my $prompt = '/\>\ /';
     my $prompt= '/'.$Web::Terminal::Settings::init_pattern.'/';
+    $self->{'error'}=0;
+    $self->{'recent'}=[];
         ## Start pugs
 #    $ENV{PUGS_SAFEMODE}=1;# Must be in CGI script!
         ( $self->{'pty'},$self->{'pid'} ) =
     &spawn($Web::Terminal::Settings::command);    # spawn() defined below
-
+    if ( $self->{'pty'}==-1 and  $self->{'pid'}==0) {
+        $self->{'init'}= "\nThere was a problem starting pugs. Please try again later.";
+        $self->{'error'}=1;
+    } else {
         ## Create a Net::Telnet object to perform I/O on pugs's tty.
         use Net::Telnet;
@@ -35 +41 @@
         );
         #( $self->{'init'}, my $m ) = $self->{'pugs'}->waitfor(
-        ( my $p, my $m ) = $self->{'pugs'}->waitfor(
+    my $error='';
+    ( my $p, my $m ) = $self->{'pugs'}->waitfor(
                 -match   => $self->{'pugs'}->prompt,
                 -errmode => "return"
-          ) or die "starting pugs failed: ", $self->{'pugs'}->lastline;
-        $self->{'init'}= $p.$m;#$self->{'pugs'}->prompt;
+          ) or do {
+          $self->{'error'}=1;
+          $error="\nThere was a problem starting pugs. Please try again later.";
+          # should close the TTY
+          $self->{'pugs'}->close();
+      };
+      #die "starting pugs failed: ", $self->{'pugs'}->lastline;
+        $self->{'init'}= $p.$m.$error;#$self->{'pugs'}->prompt;
+    }
         bless($self,$class);
         return $self;
@@ -54 +68 @@
 
         if ( $cmd eq $Web::Terminal::Settings::quit_command ) {
+        $obj->{pugs}->close();
                 kill 9, $obj->{'pid'};          
                 return "\n$Web::Terminal::Settings::quit_message\n";
@@ -64 +79 @@
 
         $pugs->print($cmd);
-        while (1) {
+        while ($i<$Web::Terminal::Settings::nlines) {
                 my $line = $pugs->getline;
         my $msg=$pugs->errmsg;
@@ -72 +87 @@
             $pugs->errmsg([]);
             $lline="${Web::Terminal::Settings::prompt} Sorry, that took too long! Aborted.\n";
+            $pugs->close();
             $ps=$Web::Terminal::Settings::prompt;
+            $obj->{'error'}=1;
             last;
         }
@@ -84 +101 @@
 
         #$lline .= "\n$ps>";
+   if ($i>=$Web::Terminal::Settings::nlines-1) {
+       $obj->{pugs}->close();
+        kill 9, $obj->{'pid'};
+        $lline.="Generated output is limited to $Web::Terminal::Settings::nlines lines. Aborted.\npugs";
+        $obj->{'error'}=1;
+    }
+
     chomp $ps; # a hack!
         $lline .= $ps;
@@ -92 +116 @@
         my (@cmd) = @_;
         my ( $pid, $pty, $tty, $tty_fd );
-
+    my $error=0;
         ## Create a new pseudo terminal.
         use IO::Pty ();
         $pty = new IO::Pty
-          or die $!;
+          or do {
+          return ( -1, 0 );
+      };
+      #die $!;
     binmode $pty, ":utf8"; 
         ## Execute the program in another process.
         unless ( $pid = fork ) {    # child process
-                die "problem spawning program: $!\n" unless defined $pid;
-
+        #       die "problem spawning program: $!\n" unless defined $pid;
+     if (not defined $pid) {
+        $pty->close();
+        $error=1;
+    } else { # all is well
                 ## Disassociate process from existing controlling terminal.
                 use POSIX ();
                 POSIX::setsid
-                  or die "setsid failed: $!";
+                  or ($error=1);#die "setsid failed: $!";
 
                 ## Associate process with a new controlling terminal.
@@ -114 +144 @@
 
                 ## Make stdio use the new controlling terminal.
-                open STDIN,  "<&$tty_fd" or die $!;
-                open STDOUT, ">&$tty_fd" or die $!;
-                open STDERR, ">&STDOUT"  or die $!;
+                open STDIN,  "<&$tty_fd" or ($error=1);#die $!;
+                open STDOUT, ">&$tty_fd" or ($error=1);#die $!;
+                open STDERR, ">&STDOUT"  or ($error=1);#die $!;
         binmode STDIN, ":utf8";
         binmode STDOUT, ":utf8";
@@ -124 +154 @@
                 ## Execute requested program.
                 exec @cmd
-                  or die "problem executing $cmd[0]\n";
+                  or  ($error=1);#die "problem executing $cmd[0]\n";
+          }
         }    # end child process
+
+    if($error==1) {
+        $pty=-1;
+        $pid=0;
+    }
 
         return ( $pty, $pid );

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

@@ -27 +27 @@
 timeout_idle
 timeout_call
+nlines
+daemon
+perl
+server
+cgi_path
+nrecent
 );
 
-our $command='/usr/bin/pugs';
+our $command='/usr/local/bin/ghci';
+our $prompt='Prelude> ';
+our $prompt_pattern='(^(Prelude)>\s+)';
+our $quit_pattern='^Leaving\ GHCi\.';
+our $quit_message='Leaving GHCi.';
 
-our $prompt='pugs> ';
+
+#our $command='/usr/bin/nice /usr/bin/pugs';
+our $server='termserv2.pl';
+#our $prompt='pugs> ';
 our $init_pattern='(\>\s+)';
-our $prompt_pattern='(^(pugs|\.\.\.\.)>\s+)';
+#our $prompt_pattern='(^(pugs|\.\.\.\.)>\s+)';
 our $quit_command=':q';
-our $quit_pattern='^Leaving\ pugs\.';
-our $quit_message='Leaving pugs.';
+#our $quit_pattern='^Leaving\ pugs\.';
+#our $quit_message='Leaving pugs.';
 
 our $filter=0;
 our $filter_pattern='';
-
+our $cgi_path='/home/andara/apache/cgi-bin/';
+our $daemon=0;
 our $port=2057;
 our $host='localhost';
@@ -50 +64 @@
 our $timeout_call=10;
 our $check_interval=300;
+our $nlines=250;
+our $nrecent=10;
+our $perl='/usr/bin/perl';
+

misc/runpugs/lib/WebTerminal/Msg.pm

@@ -249 +249 @@
 sub _new_client {
     my $sock = $main_socket->accept();
-    #returns undef on fail!
-    ## so:
+    #returns undef on fail. Calling peerhost on undef makes it die.
+    ## so: 
+    if (defined $sock) {
     my $conn = bless {
         'sock' =>  $sock,
@@ -264 +265 @@
         $conn->disconnect();
     }
+    } else {
+    #what?
+        return undef;
+    }
 }
 

misc/runpugs/lib/WebTerminal/Server.pm

@@ -46 +46 @@
                 my $lines = $term->write($cmd);
                 if ( $cmd eq ':q' ) {
+                 my $pid= $terminals{$id}->{pid};
                         delete $terminals{$id};
-                 my $pid= $terminals{$id}->{pid};
                  if ($pid) {
                      kill 9,$pid;
@@ -54 +54 @@
                 }
             if ($lines=~/Aborted/s) {
+                 my $pid= $terminals{$id}->{pid};
                  delete $terminals{$id};
-                 my $pid= $terminals{$id}->{pid};
                  if ($pid) {
                      kill 9,$pid;
@@ -75 +75 @@
                     $terminals{$id}->{ip}=$ip;
                         my $term = $terminals{$id};
-                return $term->{'init'};
+                my $init= $term->{'init'};
+                my $error= $term->{'error'};
+                if ($error==1) { # Failed to create a new terminal
+                $sessions_per_ip{$ip}--;
+                delete $terminals{$id};
+                } 
+                return $init;
             }
             }
@@ -111 +117 @@
     my $port=shift;
     $SIG{USR1}=\&timeout;
-my $daemon=1;
+my $daemon=0;
 if ($daemon) {
     Proc::Daemon::Init;

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

@@ -17 +17 @@
         #my $prompt = '/\>\ /';
         my $prompt = '/>\ /';
+    $self->{'error'}=0;
         ## Start pugs
 #    $ENV{PUGS_SAFEMODE}=1;# Must be in CGI script!
-        ( $self->{'pty'},$self->{'pid'} ) = &spawn("/usr/bin/pugs");    # spawn() defined below
-
+        ( $self->{'pty'},$self->{'pid'} ) = &spawn("/usr/bin/nice /usr/bin/pugs");    # spawn() defined below
+if ( $self->{'pty'}==-1 and  $self->{'pid'}==0) {
+    $self->{'init'}= "\nThere was a problem starting pugs. Please try again later.";
+    $self->{'error'}=1;
+} else {
         ## Create a Net::Telnet object to perform I/O on pugs's tty.
         use Net::Telnet;
@@ -38 +42 @@
 #      die "starting pugs failed: ", $self->{'pugs'}->lastline;
       $error="\nThere was a problem starting pugs. Please try again later.";
+      $self->{'error'}=1;
+      # should close the TTY
+      $self->{'pugs'}->close();
       };
         $self->{'init'}= $p.$m.$error;#$self->{'pugs'}->prompt;
+    }
         bless($self,$class);
         return $self;
@@ -66 +74 @@
 #           print "L:",$line,":",$msg;
             if($msg=~/timed/) {
-        $msg='';
-        $pugs->errmsg([]);
-        $lline="pugs> Sorry, that took too long! Aborted.\n";
-        $ps='pugs';
-        last;
+            $msg='';
+            $pugs->errmsg([]);
+            $lline="pugs> Sorry, that took too long! Aborted.\n";
+#            $pugs->close();
+            $ps='pugs';
+            $obj->{'error'}=1;
+            last;
         }
         $msg='';
@@ -78 +88 @@
         }
     if ($i>=255) {
+#            $pugs->close();
      kill 9, $obj->{'pid'};
+            $obj->{'error'}=1;
      $lline.="Generated output is limited to 100 lines. Aborted.\npugs";
     }
@@ -90 +102 @@
         my (@cmd) = @_;
         my ( $pid, $pty, $tty, $tty_fd );
-
+    my $error=0;
         ## Create a new pseudo terminal.