SPUG: shell script event loops + wrapping shell utilities
dancerboy
dancerboy at strangelight.com
Sat Apr 20 16:11:41 CDT 2002
At 4:29 pm -0700 2002-04-19, William Julien wrote:
>I have done something simular, but I used a client/server approach.
>The client sets up a bi-directional socket communication with the
>server. The server just waits for commands and runs commands or does
>actions on behalf of the client. In this case, it just stats a file
>for directory, or tells them who is logged in. A fun little toy. The
>nice thing about this approach, the client and server don't have to
>be on the same computer. In the following example, the server does
>not fork, so it can only handle one client at a time. This I leave
>as an exercise to the reader.
???
I don't really understand what this has to do with my problem.
As for the other suggestions:
select(), whether invoked directly or via IO::Select, seems to block
forever, regardless of what's coming in through the TTY.
E.g. I tried adding this before my "event loop" (as per perldoc -f select):
>sub fhbits {
> my(@fhlist) = split(' ',$_[0]);
> my($bits);
> for (@fhlist) {
> vec($bits,fileno($_),1) = 1;
> }
> return $bits;
>}
>
>my $rin = fhbits('TTY FROM_SHELL SHELL_ERR');
And added this to the loop:
> select( $rin, undef, undef, undef );
But this just blocked forever, even when there was definitely input
on TTY. (Then, after I'd killed the hung process, all the lines that
I had typed while the process was running were still in the buffer,
and would get passed to the shell that had invoked the script.)
I got similar results when I used IO::Select.
My current solution, which works pretty well, is to use the select
call as just a fine-grained "sleep" call:
>while ( not $pipe_error ) {
> while( sysread(TTY, $from_term, 1) ) {
> print TO_SHELL $from_term;
> }
> while( sysread(FROM_SHELL, $from_shell, 1) ) {
> myprint "$from_shell" if defined($from_shell);
> }
> while( sysread(SHELL_ERR, $from_shell, 1) ) {
> myprint "$from_shell" if defined($from_shell);
> }
> select( undef, undef, undef, 0.1 );
>}
The 0.1 second wait is short enough that it's not really noticeable,
but long enough that it keeps the process from hogging the CPU. (I
had earlier tried a similar trick with sleep(), but the 1-second
delay -- the smallest that one can get with sleep() -- was really
irritating.)
Still, I wish I knew, just for my own edification, why select() isn't
working the way it's supposed to.
As for "Expect": it does look pretty cool. I'll have to look at it
more when I get a chance...
-jason
>
>In perl, there is always more than one way to do it.
>
>Here is some sample code:
>
>-->cat biclient.pl
>#!/usr/bin/perl -w
>#
># biclient - bidirectional forking client
>
>use strict;
>use IO::Socket;
>my($port, $host, $handle, $line, $kidpid);
>
>$port = "1999";
>$host = "localhost";
>
># create a tcp connection to the specified host and port
>$handle = IO::Socket::INET->new(Proto => "tcp",
> PeerAddr => $host,
> PeerPort => $port)
> or die "can't connect to port $port on $host: $!";
>
>$handle->autoflush(1); # so output gets there right away
>print "[Connected to $host:$port]\n";
>
># split the program into two processes, identical twins
>die "can't fork: $!" unless defined($kidpid = fork());
>
>if ($kidpid) {
># parent copies the socket to standard output
> while (defined ($line = <$handle>)) {
> print $line;
> }
> #kill("TERM" => $kidpid); # send SIGTERM to child
>}
>else {
> # child copies standard input to the socket
> while (defined ($line = <>)) {
> print $handle $line;
> }
>}
>
>-->cat stat_server.pl
>#!/usr/bin/perl -Tw
>#
># server to listen on port 1999 and return a stat of a file
>#
>###
>
>#
># modules
>#
>use strict;
>use IO::Socket;
>
>#
># secure environment
>#
>$ENV{PATH}="";
>
>#
># declare variables
>#
>my ($socket, # client socket connection
> $client, # client handle
> @stat, # file stat data
> );
>
>#
># make a socket connection to port 1999
>#
>$socket = IO::Socket::INET->new(Proto=>"tcp",
> LocalPort=>"1999",
> Listen=>1
> )
> or die "Cannot create server socket: $!\n";
>
>#
># loop forever for client connections
>#
>while (1) {
> $client = $socket->accept;
> $client->autoflush(1);
>
> while (<$client>) {
> chomp;
> s/\r//;
> # client is done
> if ( "$_" eq "." ) {
> close $client;
> last;
> }
> # say hello (we are a friendly server)
> if ( "$_" eq "hello" ) {
> print $client "Hello. Nice to meet you.\n";
> print $client "Please enter a file name.\n";
> next;
> }
> # run a command
> if ( $_ eq "w" ) {
> print $client `/usr/bin/w`;
> next;
> }
> # server kill command
> if ( "$_" eq "kill" ) {
> close $client;
> close $socket;
> exit;
> }
> # stat a file or a directory
> if ( -e "$_" ) {
> @stat = stat("$_");
> print $client "$_: @stat\n";
> } else {
> print $client "File Not Found: $_\n";
> }
> next;
> }
>}
>
>Sample Run:
>
>#
># start the server
>#
>-->stat_server.pl &
>[2] 13035
>
>#
># Connect as a client
>#
>-->biclient.pl
>[Connected to localhost:1999]
>hello
>Hello. Nice to meet you.
>Please enter a file name.
>/vmlinuz
>/vmlinuz: 770 171 33188 1 0 0 0 972211 1015755887 1015755887
>1015755887 4096 1910
>/home/moonbeam
>/home/moonbeam: 779 80481 16877 47 502 100 0 8192 1019216446
>1019089720 1019089720 4096 16
>w
> 4:17pm up 37 days, 22:22, 6 users, load average: 0.00, 0.00, 0.00
>USER TTY FROM LOGIN@ IDLE JCPU PCPU WHAT
>moonbeam pts/2 gamymede.catmano 27Mar02 1:39 2.14s 0.05s mailx
>moonbeam pts/3 gamymede.catmano 3Apr02 23:15m 0.36s 0.05s -su
>moonbeam pts/4 gamymede.catmano 2Apr02 0.00s 55.19s 0.19s
>/usr/bin/perl -
>moonbeam pts/6 gamymede.catmano 6Apr02 5days 0.46s 0.46s -ksh
>moonbeam pts/7 whitecat.catmano Tue 4pm 2days 0.11s 0.11s -ksh
>moonbeam pts/8 whitecat.catmano Tue 7pm 2days 0.21s 0.21s -ksh
>/home/moonbeam/junk
>File Not Found: /home/moonbeam/junk
>.
>
>#
># reconnect as a client and drop the server
>#
>-->biclient.pl
>[Connected to localhost:1999]
>hello
>Hello. Nice to meet you.
>Please enter a file name.
>kill
>[2] + Done stat_server.pl &
>
>---
> William Julien _,'| _.-''``-...___..--';
>moonbeam at catmanor.com /, \'. _..-' , ,--...--'''
> vi is my shepherd; < \ .`--''' ` /|
> i shall not font. `-,;' ; ; ;
> __...--'' __...--_..' .;.'
> (,__....----''' (,..--''
>perl -e 'print $i=pack(c5,(41*2),sqrt(7056),(unpack(c,H)-2),oct(115),10);'
>perl -e '( $ ,, $ ")=("a".."z")[0,-1]; print "sh", $ ","m\n";;";;"'
>
>>
>>So, I wanted to add some minor functionality to a couple of shell
>>programs (telnet and ftp, specifically) and the simplest way seemed
>>to be simply to wrap them in a Perl script, i/e simply make a Perl
>>script that opens the program, and pipes input from the terminal
>>(keystrokes) through to the program, and passes characters output
>>from the program back to the terminal -- occasionally adding some
>>extra keystrokes of its own (the added functionality) but mostly just
>>acting as a "bidirectional pipe" between the program and the terminal.
>>
>>Here is the main wrapper part of the ftp version of the script
>>(greatly stripped-down for clarity):
>>
>>____________________________
>>#!/usr/bin/perl
>>
>>use strict;
>>use Fcntl;
>>use IPC::Open3;
>>
>>$| = 1;
>>
>>my $from_term;
>>my $from_shell;
>>my $pipe_error;
>>
>>open(TTY, "+</dev/tty") or die "no tty: $!";
>>fcntl( TTY, F_SETFL, O_NONBLOCK );
>>
>>my $pid = open3( \*TO_SHELL, \*FROM_SHELL, \*SHELL_ERR,
>> 'ftp -v strangelight.com'
>>);
>>
>>fcntl( FROM_SHELL, F_SETFL, O_NONBLOCK );
>>fcntl( SHELL_ERR, F_SETFL, O_NONBLOCK );
>>
>>my $oldfh = select(FROM_SHELL); $| = 1; select($oldfh);
>>$oldfh = select(SHELL_ERR); $| = 1; select($oldfh);
>>$oldfh = select(TTY); $| = 1; select($oldfh);
> >
>>$SIG{PIPE} = sub { ++$pipe_error; };
>>
>>while ( not $pipe_error ) {
>> while( defined( $from_term = getc(TTY) ) ) {
>> print TO_SHELL $from_term;
>> }
>> while( defined( $from_shell = getc(FROM_SHELL) ) ) {
>> print $from_shell;
>> }
>> while( defined( $from_shell = getc(SHELL_ERR) ) ) {
>> print $from_shell;
>> }
>>}
>>
>>__END__
>>
>>Now, I have two questions.
>>
>>My first question is, admittedly, one of those "I could probably
>>figure it out on my own but I'm lazy so I'll ask the folks on SPUG
>>instead" questions:
>>
>>While my script works fairly well as-is, it's a real processor hog,
>>as you can probably guess. All of those getc() calls are
>>non-blocking, so even when there's no input or output to process, the
>>main while() loop still keeps executing over and over again, doing
>>absolutely nothing as fast as it possibly can. What's the
>>best/simplest way to tell Perl to "go to sleep, but wake up as soon
>>as something interesting happens"?
>>
>>My second question is one I've banged my head on for a while and
>>haven't been able to figure out at all:
>>
>>Even with setting $|=1 on all the open pipes, I still don't always
>>get my I/O flushed promptly -- in particular, the responses I read
>>back from FROM_SHELL seem often to be one or two lines behind what I
>>should be getting. (My work-around has been to send a no-op command
>>like 'pwd', the response to which usually forces the lines that I
>>want to see out of the buffer.) What else can I do to get my pipes
> >"piping hot" (as the perldocs say)?
> >
>>-jason
>>
>> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
>> POST TO: spug-list at pm.org PROBLEMS: owner-spug-list at pm.org
>> Subscriptions; Email to majordomo at pm.org: ACTION LIST EMAIL
>> Replace ACTION by subscribe or unsubscribe, EMAIL by your Email-address
>> For daily traffic, use spug-list for LIST ; for weekly, spug-list-digest
>> Seattle Perl Users Group (SPUG) Home Page: http://seattleperl.org
>>
>
> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> POST TO: spug-list at pm.org PROBLEMS: owner-spug-list at pm.org
> Subscriptions; Email to majordomo at pm.org: ACTION LIST EMAIL
> Replace ACTION by subscribe or unsubscribe, EMAIL by your Email-address
> For daily traffic, use spug-list for LIST ; for weekly, spug-list-digest
> Seattle Perl Users Group (SPUG) Home Page: http://seattleperl.org
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
POST TO: spug-list at pm.org PROBLEMS: owner-spug-list at pm.org
Subscriptions; Email to majordomo at pm.org: ACTION LIST EMAIL
Replace ACTION by subscribe or unsubscribe, EMAIL by your Email-address
For daily traffic, use spug-list for LIST ; for weekly, spug-list-digest
Seattle Perl Users Group (SPUG) Home Page: http://seattleperl.org
More information about the spug-list
mailing list