Changeset 16595

Show
Ignore:
Timestamp:
06/01/07 18:08:37 (18 months ago)
Author:
andara
Message:

[runpugs] - Settings now go in $HOME/.webtermrc (using Config::General).

Look at webtermrc for example settings.

  • Prompt detection now more robust.
  • Easier back-end testing with command-line REPLs (see /bin).
Location:
misc/runpugs
Files:
1 added
9 modified

Legend:

Unmodified
Added
Removed

  • misc/runpugs/README

    r16564 r16595  
    11============================================================================== 
    2 2007/05/07      Release of version 0.4.0 of runpugs/Web::Terminal 
     22007/06/01      Release of version 0.4.0 of runpugs/Web::Terminal 
    33============================================================================== 
    44 
    55NAME 
    6     runpugs: a web teminal for interactive pugs  
     6    runpugs: a web terminal for interactive pugs  
    77    Web::Terminal: library for building a web terminal for interactive shells 
    88 
    … …  
    2020        Net::Telnet  
    2121        IO::Pty 
     22        Config::General 
    2223 
    23     * make sure that you change the following settings in lib/Web/Terminal/Settings.pm 
    24         $rel_root       (Release pugs) 
    25         $dev_root       (Development pugs) 
    26         $root           (web root) 
    27         $port           (usually should be 2059) 
    28         $server         (bin/termserv4.pl) 
     24    * create a $HOME/.webtermrc configuration file (start from the webtermrc file in the repository) 
     25    * make sure that you change the following settings 
     26        rel_root        (Release pugs) 
     27        dev_root        (Development pugs) 
     28        root            (web root) 
     29        port            (default 2059; any free TCP port is OK) 
     30        server          (bin/termserv.pl) 
    2931         
    30     * Start the terminal server script (bin/termserv4.pl)  
     32    * Start the terminal server script (bin/termserv.pl)  
    3133     
    3234    * To run, simply point your browser to /runpugs/  
    … …  
    3436DESCRIPTION 
    3537    runpugs has two main components:  
    36     -a mod_perl script (/perl/runpugs3.pl) which uses an html template 
    37     (/data/runpugs_async3.html). The latter calls the runpugs.css stylesheet from 
     38    -a mod_perl script (/perl/runpugs.pl) which uses an html template 
     39    (/data/runpugs_async.html). The latter calls the runpugs.css stylesheet from 
    3840    /htdocs/runpugs.css. The script is called from /htdocs/runpugs/index.html 
    39     -a server (/bin/termserv3.pl) which handles the interactive pugs sessions and communicates with 
     41    -a server (/bin/termserv.pl) which handles the interactive pugs sessions and communicates with 
    4042    the mod_perl script. The pugs sessions stay alive for some time (currently 10') if 
    4143    left inactive. 
    4244 
    4345    This version has some AJAX goodness and runs under mod_perl. 
    44     The entrypoint is /htdocs/runpugs/index.html, which calls /perl/runpugs3.pl 
     46    The entrypoint is /htdocs/runpugs/index.html, which calls /perl/runpugs.pl 
    4547 
    4648   The underlying library, Web/Terminal, can in principle be used for any 
    … …  
    6264    -Better session management 
    6365    -use Moose for Session objects 
    64     -More generic (Settings.pm) 
     66    -More generic (Settings.pm uses Config::General)  
    6567 
    6668CHANGES IN VERSION 0.3.0 

  • misc/runpugs/bin/perl_repl.pl

    r16228 r16595  
    44#use lib '../lib','/home/andara/lib/perl/5.8.8'; 
    55use Repl; 
    6  
     6my $prompt ='pugs> '; 
     7my $motd ='Simple Perl REPL'; 
    78my $subref = sub { 
    89        my $cmd = shift; 
    910        my $res = eval($cmd); 
    10         return $res; 
     11        return ($res,$prompt); 
    1112}; 
    12 my $prompt ='pugs> '; 
    13 my $motd ='Simple Perl REPL'; 
     13 
    1414 
    1515my $repl = new Repl {subref=>$subref,prompt=>$prompt,motd=>$motd}; 

  • misc/runpugs/bin/test_session.pl

    r16218 r16595  
    1313my $session=create_session($app); 
    1414 
    15 my $subref = sub {my $cmd=shift;my $res=$session->write($cmd);chomp $res; return $res;}; 
     15my $subref = sub {my $cmd=shift;my $res=$session->write($cmd);chomp $res; return ($res,$session->{'prompt'});}; 
    1616 
    1717my $prompt =$session->prompt; 

  • misc/runpugs/bin/test_session_dispatcher.pl

    r16218 r16595  
    77use Web::Terminal::Dispatcher; 
    88$Web::Terminal::Settings::port=2059; 
    9  
    10 my $app=(defined $ARGV[0])?$ARGV[0]:2; 
     9my $app; 
     10if (defined $ARGV[0]){ 
     11        $app=$ARGV[0]; 
     12} else { 
     13die "Usage: $0 app (0|1|2) [id (default 42)].\n"; 
     14} 
    1115my $id=(defined $ARGV[1])?$ARGV[1]:42; 
    1216$id='testsession'.$id; 
    … …  
    1721(my $reply,my $prompt,my $histref) = 
    1822&Web::Terminal::Dispatcher::send($id,$ip,$app,1,$cmd); 
    19 return $reply; 
     23return ($reply,$prompt); 
    2024}; 
    2125 

  • misc/runpugs/lib/Repl.pm

    r16218 r16595  
    1818                /\:q(uit)*$/i && exit(); 
    1919                chomp $_; 
    20                 my $res=$s->subref->($_); 
    21                 print $res,"\n",$s->prompt; 
     20                (my $res,my $prompt)=$s->subref->($_); 
     21                print $res,"\n",$prompt; 
    2222        } 
    2323} 

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

    r15833 r16595  
    2121                                         DEFAULT => [], 
    2222); 
    23 my $v = (1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 
     23my $v = 1;#(1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 
    2424 
    2525sub send { 

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

    r16218 r16595  
    4343 
    4444# verbose 
    45 my $v                 = (1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 
     45my $v                 = 1;#(1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 
    4646 
    4747# Datastructures per app, so $session{$app}{...}, $inactive[$app][...] or @{$inactive[$app]} 
    … …  
    387387                                } 
    388388                        } else { 
    389 print "    Session $id ($app,$cmd) is not active:", exists( $active_sessions[$app]{$id}),"\n" if $v; 
     389print "    Session $id ($app,$cmd) is not active:", (defined $active_sessions[$app])?exists( $active_sessions[$app]{$id}):'(empty)',"\n" if $v; 
    390390                                # new session 
    391391                           assert($n_inactive_sessions[$app]==scalar( @{ $inactive_sessions[$app] })); 
    … …  
    421421                                                # asynchronously create new sessions 
    422422                                                &async_init_create(); 
    423                                                 return $ret; 
     423                                                my $term = $sessions[$app]{$ret}; 
     424                                                my $motd=$term->{'motd'}; 
     425                                                return $motd; 
    424426                                        } else { 
    425427                                                print 
    … …  
    696698        return 1; 
    697699    } else { 
     700        print "PUGS_SAFEMODE=1 $cmd -e \"print 42\" 2>/dev/null\n"; 
    698701    my $reply=`PUGS_SAFEMODE=1 $cmd -e \"print 42\" 2>/dev/null`; 
    699702    if ($reply==42) { 

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

    r16219 r16595  
    1515$SIG{CHLD}='IGNORE'; 
    1616 
    17 my $v=(1-$Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 
     17my $v=1;#(1-$Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test); 
    1818 
    1919    my $prompt ='/'.$Web::Terminal::Settings::prompt.'/'; 
    … …  
    3030    has 'pty' => (is=>'rw',isa=>'Any'); 
    3131    has 'pid' => (is=>'rw',isa=>'Int'); 
     32    has 'motd' => (is=>'rw',isa=>'Str'); 
    3233     
    3334    sub BUILD { 
    … …  
    3738    my $app=$self->app; 
    3839    my $command=$Web::Terminal::Settings::commands[$app]; 
    39     if (not $Web::Terminal::Settings::test) { 
     40    if ($Web::Terminal::Settings::test!=1) { 
    4041    if ($self->ia==0) { 
    4142        #1. Create a file with the content of $cmd using $id.p6 for name, store in data 
    … …  
    6869                -telnetmode      => 0, 
    6970                -cmd_remove_mode => 0, 
     71                -input_record_separator => "\n", 
    7072        ); 
    7173    } 
    … …  
    7678        print "Reading Pugs startup message...\n" if $v; 
    7779    my $m=$self->readlines(); 
     80    $self->{'motd'}=$m; 
    7881      if ($self->{'error'}==1 and not $Web::Terminal::Settings::test) { 
    7982          # should close the TTY 
    … …  
    170173sub DESTROY { 
    171174    my $obj = shift; 
    172     if (not $Web::Terminal::Settings::test) { 
     175    if ( $Web::Terminal::Settings::test!=1) { 
    173176        if (defined $obj->{'pty'}) { 
    174177    $obj->{'pty'}->close(); 
    … …  
    193196                my $i     = 1; 
    194197        my $lline = ''; 
    195 if (not $Web::Terminal::Settings::test) { 
     198if ( $Web::Terminal::Settings::test!=1) { 
    196199        if ( $cmd eq $Web::Terminal::Settings::quit_command ) { 
    197200        $obj->{pugs}->close(); 
    … …  
    206209        while ($i<$Web::Terminal::Settings::nlines) { 
    207210                my $line = $pugs->getline; 
    208         my $msg=$pugs->errmsg; 
    209             print "L:",$line,":",$msg if $v; 
    210             if($msg=~/timed/) { 
    211             $msg=''; 
    212             $pugs->errmsg([]); 
    213             $lline="${Web::Terminal::Settings::prompt} Sorry, that took too long! Aborted.\n"; 
    214             $pugs->close(); 
    215             $ps=$Web::Terminal::Settings::prompt; 
    216             $obj->{'error'}=1; 
    217             last; 
    218         } 
    219         $msg=''; 
    220         if ( ($line =~ /$Web::Terminal::Settings::prompt_pattern/ or 
    221         ($line=~/$Web::Terminal::Settings::quit_pattern/)) and $i > 1 ) { $ps = $1; last } 
     211                my $msg=$pugs->errmsg; 
     212                    print "L:{",$line,"}\n",$msg if $v; 
     213                    if($msg=~/timed/) { 
     214                            $msg=''; 
     215                            $pugs->errmsg([]); 
     216                            $lline="${Web::Terminal::Settings::prompt} Sorry, that took too long! Aborted.\n"; 
     217                            $pugs->close(); 
     218                            $ps=$Web::Terminal::Settings::prompt; 
     219                            $obj->{'error'}=1; 
     220                            last; 
     221                        } 
     222                $msg=''; 
     223# print "\nTEST",$Web::Terminal::Settings::prompt_pattern,"\n";  
     224#print ('(^(pugs|\.\.\.\.)>\s+)' eq $Web::Terminal::Settings::prompt_pattern); 
     225#if ($line=~/pugs/) { 
     226#print "OK!\n"; 
     227#} 
     228                if ( ($line =~ /$Web::Terminal::Settings::prompt_pattern/ or 
     229                ($line=~/$Web::Terminal::Settings::quit_pattern/)) and $i > 1 ) {  
     230                        $ps = $1; 
     231                       my $ps1=$ps;      
     232                        my $charnum=ord(chop $ps1); 
     233                        if ($charnum<32) { 
     234                                $ps=$ps1; 
     235                        } 
     236                        last; 
     237                } 
    222238                $lline .= $line unless $line =~ 
    223         /$Web::Terminal::Settings::prompt_pattern/; 
     239                /$Web::Terminal::Settings::prompt_pattern/; 
    224240                $i++; 
    225241        } 
    … …  
    252268#       my $i     = 1; 
    253269        my $lline = ''; 
    254         if (not $Web::Terminal::Settings::test) { 
     270        if ( $Web::Terminal::Settings::test!=1) { 
    255271    my $pugs=$obj->{'pugs'}; 
    256272    $pugs->errmode(sub {kill 9,$obj->{'pid'}; }); 
    … …  
    275291#    #} else {die;$prev=1;} 
    276292#    } 
    277    
     293# print "TEST",$Web::Terminal::Settings::prompt,"\n";  
    278294        ($line, $ps)=$pugs->waitfor(String=>$Web::Terminal::Settings::prompt); 
    279295          $pugs->buffer_empty(); # maybe redundant, but play safe    

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

    r16228 r16595  
    55use vars qw( $VERSION ); 
    66$VERSION = '0.4.0'; 
    7 use utf8; 
     7#use utf8 
    88use strict; 
     9 
     10use Config::General; 
    911 
    1012use Exporter; 
    … …  
    5153); 
    5254 
    53 #ghci 
    54 ##GHCi 
    55 #our $command='/usr/local/bin/ghci'; 
    56 #our $prompt='Prelude> '; 
    57 #our $prompt_pattern='(^(Prelude)>\s+)'; 
    58 #our $quit_pattern='^Leaving\ GHCi\.'; 
    59 #our $quit_message='Leaving GHCi.'; 
    60 #cut 
     55#my %config = Config::General::ParseConfig("./wtrc"); 
     56 my $conf = new Config::General( 
     57         -ConfigFile => $ENV{'HOME'}.'/.webtermrc', 
     58         -InterPolateVars=>1, 
     59         -InterPolateEnv=>1 
     60                ); 
     61my %config=$conf->getall(); 
    6162 
    62 #Pugs 
    63 my $ulimit='ulimit -m 64000; ulimit -v 64000;'; 
    64 my $nice='/usr/bin/nice'; 
    65 my $pugs='/usr/bin/pugs'; 
    66 my $rel_root='/home/andara/pugs-rel'; 
    67 my $dev_root='/home/andara/pugs-dev'; 
    68 my $rel_lib="-I$rel_root/blib6/lib"; 
    69 my $dev_lib="-I$dev_root/blib6/lib"; 
     63no strict 'refs'; 
    7064 
    71 #$ulimit=''; 
    72 #$nice='';#/bin/nice'; 
    73 #$pugs='/usr/bin/pugs'; 
    74 #$rel_root='/usr/bin'; 
    75 #$dev_root='/usr/bin'; 
    76 #$rel_lib=''; 
    77 #$dev_lib=''; 
     65for my $key (keys %config) { 
     66        my $fkey="Web::Terminal::Settings::$key"; 
     67        if ($config{$key}=~/^\(\d+(,\d+)*\)/) { 
     68                my $vals=$config{$key}; 
     69                $vals=~s/[\(\)]//g; 
     70                @{$fkey}=split(/,/,$vals); 
     71        } else { 
     72                ${$fkey}=$config{$key}; 
     73        } 
     74} 
    7875 
    7976our @commands=( 
    80 "$ulimit $nice $rel_root/pugs $rel_lib", 
    81 "$ulimit $nice $dev_root/pugs $dev_lib", 
    82 #"perl ./perl_repl.pl" 
     77"$Web::Terminal::Settings::ulimit $Web::Terminal::Settings::nice $Web::Terminal::Settings::rel_root/pugs $Web::Terminal::Settings::rel_lib", 
     78"$Web::Terminal::Settings::ulimit $Web::Terminal::Settings::nice $Web::Terminal::Settings::dev_root/pugs $Web::Terminal::Settings::dev_lib", 
    8379); 
    8480 
    85 our $test=0; 
    86 our $appname='runpugs'; 
    87 our $prompt='pugs> '; 
    88 #$prompt='perl> '; 
    89 our $prompt_pattern='(^(pugs|\.\.\.\.)>\s+)'; 
    90 our $quit_pattern='^Leaving\ pugs\.'; 
    91 our $quit_message='Leaving pugs.'; 
     81if ($Web::Terminal::Settings::test==2) { 
     82        push @commands,"perl ./perl_repl.pl"; 
     83        push @Web::Terminal::Settings::n_max,1; 
     84        push @Web::Terminal::Settings::npreloaded_sessions,1; 
     85        push @Web::Terminal::Settings::n_inactive_min,1; 
     86} 
    9287 
    93 our $init_pattern='(\>\s+)'; 
    94 our $quit_command=':q'; 
    95 our $reset_command=':r'; 
    96 our $abort_command=':A'; # To simulate abort in test mode 
     88our @n_inactive_max=@Web::Terminal::Settings::npreloaded_sessions; 
    9789 
    98 our $filter=0; 
    99 our $filter_pattern=''; 
    100 my $root='/home/andara/apache'; 
    101  
    102 our $cgi_path="$root/cgi-bin/"; 
    103 our $lib_path="$root/lib/"; 
    104 our $bin_path="$root/bin/"; 
    105 our $data_path="$root/data/"; 
    106 our $tmp_path="$root/data/tmp/"; 
    107 our $log_path="$root/data/log"; 
    108 our $daemon=1; 
    109 our $port=2057; 
    110 our $host='localhost'; 
    111  
    112 our $restart_parent=0; # restart parent server from child if 1 
    113 our $server="$bin_path/termserv.pl"; # used to restart parent server from child 
    114  
    115 our $nsessions=50; # obsolete 
    116 our @n_max=(20,50);#,5); 
    117 our $nsessions_ip=10;  
    118 our @npreloaded_sessions=(5,10);#,2);  
    119 our @n_inactive_max=@npreloaded_sessions; 
    120 our @n_inactive_min=(2,5);#,0); 
    121  
    122 our $timeout_idle=90; # was 600 
    123 our $timeout_call=30; #  was 30 
    124 our $check_interval=60;  
    125 our $create_interval=5; # should be 30 I guess 
    126 our $nlines=250; 
    127 our $nchars=250; 
    128 our $nrecent=10; 
    129 our $perl='/usr/bin/perl'; 
     901; 
    13091 
    13192__END__