I received a couple of replies to my inquiry, but neither were really
what I needed. It turns out that the Comm.pl module is broken as
shipped for OSF/1 aka Digital Unix aka Compaq Tru64 Unix (what IS the
abbreviation for that?). I provide herewith some patches to Comm.pl to
make it work, but be forewarned that it also gives that routine some
modernization WRT Perl syntax (i.e., :: vs ' notation for module
dereferencing), so it's probably not Perl4 compliant anymore, not that
anybody cares by now. I did this so emacs would font-lock-mode would
fontify it reasonably (forward squotes are always viewed as beginning
text strings).
BTW, the approach I took was to use open_proc() with expect().
*** Comm.pl.~1~ Wed Aug 20 14:09:14 1997
--- Comm.pl Mon Sep 13 15:19:24 1999
***************
*** 22,32 ****
It's normally put into a file and "require"d, but can also be simply
concatinated to the end of some other perl script. If you do that, use:
! require "Comm.pl" unless defined &Comm'init;
Function summary:
! (Remember to use prefixes (i.e. "&Comm'init") for anything not exported.)
(All file handles passed up from these functions are exported into the
caller's package.)
--- 22,32 ----
It's normally put into a file and "require"d, but can also be simply
concatinated to the end of some other perl script. If you do that, use:
! require "Comm.pl" unless defined &Comm::init;
Function summary:
! (Remember to use prefixes (i.e. "&Comm::init") for anything not exported.)
(All file handles passed up from these functions are exported into the
caller's package.)
***************
*** 34,47 ****
init :
----
! &Comm'init(); # Required after "require". It sets up all
# internal symbols, and exports functions to
# caller's package.
! &Comm'init(1.8); # If first arg is numeric, it specifies a
# desired version for compatibility.
! &Comm'init(1.8, "func",...);# Tell it to export specified function(s),
# otherwise, init() will export all documented
# functions.
--- 34,47 ----
init :
----
! &Comm::init(); # Required after "require". It sets up all
# internal symbols, and exports functions to
# caller's package.
! &Comm::init(1.8); # If first arg is numeric, it specifies a
# desired version for compatibility.
! &Comm::init(1.8, "func",...);# Tell it to export specified function(s),
# otherwise, init() will export all documented
# functions.
***************
*** 91,104 ****
-----------
# Does a portable wait4/waitpid. Used mostly internally. Not exported.
! &Comm'wait_nohang( $pid );
# If pid is -1 or undef, wait for any.
wait_hang :
-----------
# Does a portable blocking waitpid. Used mostly internally. Not exported.
! &Comm'wait_hang( $pid );
# If pid is -1 or undef, wait for any.
expect :
--- 91,104 ----
-----------
# Does a portable wait4/waitpid. Used mostly internally. Not exported.
! &Comm::wait_nohang( $pid );
# If pid is -1 or undef, wait for any.
wait_hang :
-----------
# Does a portable blocking waitpid. Used mostly internally. Not exported.
! &Comm::wait_hang( $pid );
# If pid is -1 or undef, wait for any.
expect :
***************
*** 343,349 ****
08/20/97 14:08:34 AM; eric: v1.8: nasty little bug with wait_nohang.
EOF
!
--- 343,349 ----
08/20/97 14:08:34 AM; eric: v1.8: nasty little bug with wait_nohang.
EOF
! #'
***************
*** 372,378 ****
local( $pkg ) = caller;
$My_pkg = "Comm";
! *Debug = *main'Debug; # set this before export_sym
if ( !_at_args )
{
--- 372,378 ----
local( $pkg ) = caller;
$My_pkg = "Comm";
! *Debug = *main'Debug; # set this before export_sym'
if ( !_at_args )
{
***************
*** 434,440 ****
$OS_type = "SVR4";
$WNOHANG = 1;
}
! elsif ( -d "/tcb")
{
# sco seems to have a pretty worthless implementation of uname.
# the existence of /tcb seems to be sco specific and this
--- 434,440 ----
$OS_type = "SVR4";
$WNOHANG = 1;
}
! elsif ( -d "/tcb" && $OS_name ne "OSF1")
{
# sco seems to have a pretty worthless implementation of uname.
# the existence of /tcb seems to be sco specific and this
***************
*** 1048,1054 ****
# Since we have to close STDOUT/STDERR in order to get a new controlling
# tty, we have to find some other place to put the debug data:
local(*DEBUG_FH);
! $Debug=1;
if( $Debug )
{
open(DEBUG_FH, ">Comm.pl.debug" );
--- 1048,1054 ----
# Since we have to close STDOUT/STDERR in order to get a new controlling
# tty, we have to find some other place to put the debug data:
local(*DEBUG_FH);
! #$Debug=1;
if( $Debug )
{
open(DEBUG_FH, ">Comm.pl.debug" );
***************
*** 1200,1207 ****
local( _at_ptys );
# Force given filehandle names explicitly into caller's package:
! $_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
! $_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
if ( $OS_name ne "OSF1" && -e "/dev/ptmx" || -e "/dev/ptc" )
{
--- 1200,1207 ----
local( _at_ptys );
# Force given filehandle names explicitly into caller's package:
! $_PTY =~ s/^([^\']+)$/(caller)[$[]."'".$1/e;
! $_TTY =~ s/^([^\']+)$/(caller)[$[]."'".$1/e;
if ( $OS_name ne "OSF1" && -e "/dev/ptmx" || -e "/dev/ptc" )
{
***************
*** 1229,1234 ****
--- 1229,1235 ----
for $pty ( _at_ptys )
{
+ next if (!-r $pty);
open($_PTY,"+>$pty") || next;
select((select($_PTY), $| = 1)[0]);
***************
*** 1905,1911 ****
# Ideally, you probably want to keep the file handle name space
# encapsulated in this package. On the other hand, it is
! # also really nice not to have to provide a "Comm'whatever()" function for
# every Perl function which uses a file handle.
# The caller gives this a filehandle opened by main or some other package,
--- 1906,1912 ----
# Ideally, you probably want to keep the file handle name space
# encapsulated in this package. On the other hand, it is
! # also really nice not to have to provide a "Comm::whatever()" function for
# every Perl function which uses a file handle.
# The caller gives this a filehandle opened by main or some other package,
***************
*** 2326,2332 ****
& eval 'exec perl -S $0 $argv:q'
if 0;
! require "Comm.pl" unless defined &Comm'init;
$Listen_port = 5050;
$Listen_port = $ARGV[0] if $ARGV[0];
--- 2327,2335 ----
& eval 'exec perl -S $0 $argv:q'
if 0;
! require "Comm.pl" unless defined &Comm::init;
!
! #'
$Listen_port = 5050;
$Listen_port = $ARGV[0] if $ARGV[0];
***************
*** 2338,2344 ****
$DEBUG = 1;
$|=1;
! &Comm'init;
if(1)
{
--- 2341,2349 ----
$DEBUG = 1;
$|=1;
! &Comm::init;
!
! #'
if(1)
{
***************
*** 2385,2396 ****
print $buf;
# rebroadcast data to all clients:
for $client_handle ( keys %Client_handles ) {
! &Comm'print( $client_handle, $buf ); }
}
else
{
print "Closing handle $handle, host $rem_host\n";
! &Comm'close( $handle );
delete $Client_handles{ $handle };
}
}
--- 2390,2401 ----
print $buf;
# rebroadcast data to all clients:
for $client_handle ( keys %Client_handles ) {
! &Comm::print( $client_handle, $buf ); } #'
}
else
{
print "Closing handle $handle, host $rem_host\n";
! &Comm::close( $handle );
delete $Client_handles{ $handle };
}
}
***************
*** 2400,2406 ****
sub my_exit
{
! &Comm'close( $Listen_handle );
print "Closing listen port\n" if $DEBUG;
exit;
}
--- 2405,2411 ----
sub my_exit
{
! &Comm::close( $Listen_handle );
print "Closing listen port\n" if $DEBUG;
exit;
}
***************
*** 2418,2424 ****
& eval 'exec perl -S $0 $argv:q'
if 0;
! require "Comm.pl" unless defined &Comm'init;
$Server_port = 5050;
$Server_host = "serverhost.domain";
--- 2423,2429 ----
& eval 'exec perl -S $0 $argv:q'
if 0;
! require "Comm.pl" unless defined &Comm::init;
$Server_port = 5050;
$Server_host = "serverhost.domain";
***************
*** 2432,2438 ****
$|=1;
$DEBUG = 1;
! &Comm'init;
if ( ! ( $Server_handle = &open_port($Server_host, $Server_port, 5) ) )
{
--- 2437,2443 ----
$|=1;
$DEBUG = 1;
! &Comm::init;
if ( ! ( $Server_handle = &open_port($Server_host, $Server_port, 5) ) )
{
***************
*** 2468,2474 ****
sub my_exit
{
! &Comm'close($HANDLE);
exit;
}
--- 2473,2479 ----
sub my_exit
{
! &Comm::close($HANDLE);
exit;
}
***************
*** 2484,2490 ****
& eval 'exec perl -S $0 $argv:q'
if 0;
! require "Comm.pl" unless defined &Comm'init;
#$remote_addr = "129.145.43.255"; # broadcast
chop( $remote_addr = `uname -n` );
--- 2489,2495 ----
& eval 'exec perl -S $0 $argv:q'
if 0;
! require "Comm.pl" unless defined &Comm::init;
#$remote_addr = "129.145.43.255"; # broadcast
chop( $remote_addr = `uname -n` );
***************
*** 2516,2523 ****
& eval 'exec perl -S $0 $argv:q'
if 0;
! require "Comm.pl" unless defined &Comm'init;
! &Comm'init;
chop( $My_addr = `uname -n` );
--- 2521,2528 ----
& eval 'exec perl -S $0 $argv:q'
if 0;
! require "Comm.pl" unless defined &Comm::init;
! &Comm::init;
chop( $My_addr = `uname -n` );
***************
*** 2553,2559 ****
else
{
print "Closing handle $handle, host $rem_host\n";
! &Comm'close( $handle );
}
}
}
--- 2558,2564 ----
else
{
print "Closing handle $handle, host $rem_host\n";
! &Comm::close( $handle );
}
}
}
***************
*** 2562,2568 ****
sub my_exit
{
! &Comm'close( $Udp_handle );
print "Closing udp port\n" if $DEBUG;
exit;
}
--- 2567,2573 ----
sub my_exit
{
! &Comm::close( $Udp_handle );
print "Closing udp port\n" if $DEBUG;
exit;
}
***************
*** 2582,2594 ****
if 0;
require "Comm.pl";
! &Comm'init( 1.8 );
$Host = "somehost";
$User = "someuser";
$Password = "somepassword";
#$PS1 = '(\$|\%|#|Z\|) $'; # shell prompt, Z| is my weird prompt
! $PS1 = '([$%#|]) $'; # shell prompt pattern
$|=1;
$proc_handle = &open_proc( "telnet $Host" ) || die "open_proc failed";
--- 2587,2599 ----
if 0;
require "Comm.pl";
! &Comm::init( 1.8 );
$Host = "somehost";
$User = "someuser";
$Password = "somepassword";
#$PS1 = '(\$|\%|#|Z\|) $'; # shell prompt, Z| is my weird prompt
! $PS1 = '([$%#|]) \$'; # shell prompt pattern
$|=1;
$proc_handle = &open_proc( "telnet $Host" ) || die "open_proc failed";
***************
*** 2632,2645 ****
require "Comm.pl";
! &Comm'init( 1.8 );
$Program = "telnet";
#$Program = "/usr/ucb/rlogin -l qwerty"; # try this to test login recovery
$Host = "somehost";
$User = "someuser";
$Password = "somepassword";
! $Shell_prompt = '(\$|\%|#|Z\|) $'; # Z| is my weird prompt
$|=1;
--- 2637,2650 ----
require "Comm.pl";
! &Comm::init( 1.8 );
$Program = "telnet";
#$Program = "/usr/ucb/rlogin -l qwerty"; # try this to test login recovery
$Host = "somehost";
$User = "someuser";
$Password = "somepassword";
! $Shell_prompt = '(\$|\%|#|Z\|) \$'; # Z| is my weird prompt
$|=1;
***************
*** 2793,2799 ****
if 0;
require "Comm.pl";
! &Comm'init( 1.8 );
#$Debug=1;
$|=1;
--- 2798,2804 ----
if 0;
require "Comm.pl";
! &Comm::init( 1.8 );
#$Debug=1;
$|=1;
***************
*** 2824,2830 ****
if 0;
require "Comm.pl";
! &Comm'init( 1.8 );
use IPC::Open3;
$|=1;
--- 2829,2835 ----
if 0;
require "Comm.pl";
! &Comm::init( 1.8 );
use IPC::Open3;
$|=1;
--
Robert L. McMillin | Not the voice of Syseca, Inc. | rlm_at_syseca-us.com
Received on Tue Sep 14 1999 - 01:35:02 NZST