From 4ff0896c5dca220b64d2321029d70785a5c5051e Mon Sep 17 00:00:00 2001 From: Todd Rinaldo Date: Fri, 22 Jan 2021 01:57:05 -0600 Subject: [PATCH] perltidy --- ChangeLog | 1 + Pty.pm | 195 ++++++++++++++++++++++---------------------- Tty.pm | 111 ++++++++++++------------- t/pty_get_winsize.t | 4 +- t/test.t | 42 +++++----- 5 files changed, 180 insertions(+), 173 deletions(-) mode change 100755 => 100644 t/pty_get_winsize.t diff --git a/ChangeLog b/ChangeLog index 530176a..9bd9b2b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,7 @@ 1.16 2021-01-2 Todd Rinaldo * Switch to github for issue tracker. * Switch to testsuite CI workflow. + * Tidy 2020-10-03 Todd Rinaldo 1.15 * Skip winsize test on Solaris and QNX NTO diff --git a/Pty.pm b/Pty.pm index 7fc07b9..f1d9550 100644 --- a/Pty.pm +++ b/Pty.pm @@ -10,140 +10,143 @@ require POSIX; use vars qw(@ISA $VERSION); -$VERSION = '1.15'; # keep same as in Tty.pm +$VERSION = '1.15'; # keep same as in Tty.pm @ISA = qw(IO::Handle); eval { local $^W = 0; undef local $SIG{__DIE__}; require IO::Stty }; -push @ISA, "IO::Stty" if (not $@); # if IO::Stty is installed +push @ISA, "IO::Stty" if ( not $@ ); # if IO::Stty is installed sub new { - my ($class) = $_[0] || "IO::Pty"; - $class = ref($class) if ref($class); - @_ <= 1 or croak 'usage: new $class'; + my ($class) = $_[0] || "IO::Pty"; + $class = ref($class) if ref($class); + @_ <= 1 or croak 'usage: new $class'; - my ($ptyfd, $ttyfd, $ttyname) = pty_allocate(); + my ( $ptyfd, $ttyfd, $ttyname ) = pty_allocate(); - croak "Cannot open a pty" if not defined $ptyfd; + croak "Cannot open a pty" if not defined $ptyfd; - my $pty = $class->SUPER::new_from_fd($ptyfd, "r+"); - croak "Cannot create a new $class from fd $ptyfd: $!" if not $pty; - $pty->autoflush(1); - bless $pty => $class; + my $pty = $class->SUPER::new_from_fd( $ptyfd, "r+" ); + croak "Cannot create a new $class from fd $ptyfd: $!" if not $pty; + $pty->autoflush(1); + bless $pty => $class; - my $slave = IO::Tty->new_from_fd($ttyfd, "r+"); - croak "Cannot create a new IO::Tty from fd $ttyfd: $!" if not $slave; - $slave->autoflush(1); + my $slave = IO::Tty->new_from_fd( $ttyfd, "r+" ); + croak "Cannot create a new IO::Tty from fd $ttyfd: $!" if not $slave; + $slave->autoflush(1); - ${*$pty}{'io_pty_slave'} = $slave; - ${*$pty}{'io_pty_ttyname'} = $ttyname; - ${*$slave}{'io_tty_ttyname'} = $ttyname; + ${*$pty}{'io_pty_slave'} = $slave; + ${*$pty}{'io_pty_ttyname'} = $ttyname; + ${*$slave}{'io_tty_ttyname'} = $ttyname; - return $pty; + return $pty; } sub ttyname { - @_ == 1 or croak 'usage: $pty->ttyname();'; - my $pty = shift; - ${*$pty}{'io_pty_ttyname'}; + @_ == 1 or croak 'usage: $pty->ttyname();'; + my $pty = shift; + ${*$pty}{'io_pty_ttyname'}; } - sub close_slave { - @_ == 1 or croak 'usage: $pty->close_slave();'; + @_ == 1 or croak 'usage: $pty->close_slave();'; - my $master = shift; + my $master = shift; - if (exists ${*$master}{'io_pty_slave'}) { - close ${*$master}{'io_pty_slave'}; - delete ${*$master}{'io_pty_slave'}; - } + if ( exists ${*$master}{'io_pty_slave'} ) { + close ${*$master}{'io_pty_slave'}; + delete ${*$master}{'io_pty_slave'}; + } } sub slave { - @_ == 1 or croak 'usage: $pty->slave();'; + @_ == 1 or croak 'usage: $pty->slave();'; - my $master = shift; + my $master = shift; - if (exists ${*$master}{'io_pty_slave'}) { - return ${*$master}{'io_pty_slave'}; - } + if ( exists ${*$master}{'io_pty_slave'} ) { + return ${*$master}{'io_pty_slave'}; + } - my $tty = ${*$master}{'io_pty_ttyname'}; + my $tty = ${*$master}{'io_pty_ttyname'}; - my $slave = new IO::Tty; + my $slave = new IO::Tty; - $slave->open($tty, O_RDWR | O_NOCTTY) || - croak "Cannot open slave $tty: $!"; + $slave->open( $tty, O_RDWR | O_NOCTTY ) + || croak "Cannot open slave $tty: $!"; - return $slave; + return $slave; } sub make_slave_controlling_terminal { - @_ == 1 or croak 'usage: $pty->make_slave_controlling_terminal();'; + @_ == 1 or croak 'usage: $pty->make_slave_controlling_terminal();'; + + my $self = shift; + local (*DEVTTY); + + # loose controlling terminal explicitly + if ( defined TIOCNOTTY ) { + if ( open( \*DEVTTY, "/dev/tty" ) ) { + ioctl( \*DEVTTY, TIOCNOTTY, 0 ); + close \*DEVTTY; + } + } + + # Create a new 'session', lose controlling terminal. + if ( POSIX::setsid() == -1 ) { + warn "setsid() failed, strange behavior may result: $!\r\n" if $^W; + } - my $self = shift; - local(*DEVTTY); + if ( open( \*DEVTTY, "/dev/tty" ) ) { + warn "Could not disconnect from controlling terminal?!\n" if $^W; + close \*DEVTTY; + } + + # now open slave, this should set it as controlling tty on some systems + my $ttyname = ${*$self}{'io_pty_ttyname'}; + my $slv = new IO::Tty; + $slv->open( $ttyname, O_RDWR ) + or croak "Cannot open slave $ttyname: $!"; + + if ( not exists ${*$self}{'io_pty_slave'} ) { + ${*$self}{'io_pty_slave'} = $slv; + } + else { + $slv->close; + } + + # Acquire a controlling terminal if this doesn't happen automatically + if ( not open( \*DEVTTY, "/dev/tty" ) ) { + if ( defined TIOCSCTTY ) { + if ( not defined ioctl( ${*$self}{'io_pty_slave'}, TIOCSCTTY, 0 ) ) { + warn "warning: TIOCSCTTY failed, slave might not be set as controlling terminal: $!" if $^W; + } + } + elsif ( defined TCSETCTTY ) { + if ( not defined ioctl( ${*$self}{'io_pty_slave'}, TCSETCTTY, 0 ) ) { + warn "warning: TCSETCTTY failed, slave might not be set as controlling terminal: $!" if $^W; + } + } + else { + warn "warning: You have neither TIOCSCTTY nor TCSETCTTY on your system\n" if $^W; + return 0; + } + } - # loose controlling terminal explicitly - if (defined TIOCNOTTY) { - if (open (\*DEVTTY, "/dev/tty")) { - ioctl( \*DEVTTY, TIOCNOTTY, 0 ); - close \*DEVTTY; + if ( not open( \*DEVTTY, "/dev/tty" ) ) { + warn "Error: could not connect pty as controlling terminal!\n"; + return undef; } - } - - # Create a new 'session', lose controlling terminal. - if (POSIX::setsid() == -1) { - warn "setsid() failed, strange behavior may result: $!\r\n" if $^W; - } - - if (open(\*DEVTTY, "/dev/tty")) { - warn "Could not disconnect from controlling terminal?!\n" if $^W; - close \*DEVTTY; - } - - # now open slave, this should set it as controlling tty on some systems - my $ttyname = ${*$self}{'io_pty_ttyname'}; - my $slv = new IO::Tty; - $slv->open($ttyname, O_RDWR) - or croak "Cannot open slave $ttyname: $!"; - - if (not exists ${*$self}{'io_pty_slave'}) { - ${*$self}{'io_pty_slave'} = $slv; - } else { - $slv->close; - } - - # Acquire a controlling terminal if this doesn't happen automatically - if (not open(\*DEVTTY, "/dev/tty")) { - if (defined TIOCSCTTY) { - if (not defined ioctl( ${*$self}{'io_pty_slave'}, TIOCSCTTY, 0 )) { - warn "warning: TIOCSCTTY failed, slave might not be set as controlling terminal: $!" if $^W; - } - } elsif (defined TCSETCTTY) { - if (not defined ioctl( ${*$self}{'io_pty_slave'}, TCSETCTTY, 0 )) { - warn "warning: TCSETCTTY failed, slave might not be set as controlling terminal: $!" if $^W; - } - } else { - warn "warning: You have neither TIOCSCTTY nor TCSETCTTY on your system\n" if $^W; - return 0; + else { + close \*DEVTTY; } - } - - if (not open(\*DEVTTY, "/dev/tty")) { - warn "Error: could not connect pty as controlling terminal!\n"; - return undef; - } else { - close \*DEVTTY; - } - - return 1; + + return 1; } *clone_winsize_from = \&IO::Tty::clone_winsize_from; -*get_winsize = \&IO::Tty::get_winsize; -*set_winsize = \&IO::Tty::set_winsize; -*set_raw = \&IO::Tty::set_raw; +*get_winsize = \&IO::Tty::get_winsize; +*set_winsize = \&IO::Tty::set_winsize; +*set_raw = \&IO::Tty::set_raw; 1; diff --git a/Tty.pm b/Tty.pm index 3f02285..04fb642 100644 --- a/Tty.pm +++ b/Tty.pm @@ -3,7 +3,8 @@ package IO::Tty; -use strict; use warnings; +use strict; +use warnings; use IO::Handle; use IO::File; use IO::Tty::Constant; @@ -14,12 +15,12 @@ require DynaLoader; use vars qw(@ISA $VERSION $XS_VERSION $CONFIG $DEBUG); -$VERSION = '1.15'; +$VERSION = '1.15'; $XS_VERSION = "1.15"; -@ISA = qw(IO::Handle); +@ISA = qw(IO::Handle); eval { local $^W = 0; undef local $SIG{__DIE__}; require IO::Stty }; -push @ISA, "IO::Stty" if (not $@); # if IO::Stty is installed +push @ISA, "IO::Stty" if ( not $@ ); # if IO::Stty is installed BOOT_XS: { # If I inherit DynaLoader then I inherit AutoLoader and I DON'T WANT TO @@ -29,21 +30,22 @@ BOOT_XS: { *dl_load_flags = DynaLoader->can('dl_load_flags'); do { - defined(&bootstrap) - ? \&bootstrap - : \&DynaLoader::bootstrap - }->(__PACKAGE__); + defined(&bootstrap) + ? \&bootstrap + : \&DynaLoader::bootstrap; + } + ->(__PACKAGE__); } sub import { - IO::Tty::Constant->export_to_level(1, @_); + IO::Tty::Constant->export_to_level( 1, @_ ); } sub open { - my($tty,$dev,$mode) = @_; + my ( $tty, $dev, $mode ) = @_; - IO::File::open($tty,$dev,$mode) or - return undef; + IO::File::open( $tty, $dev, $mode ) + or return undef; $tty->autoflush; @@ -51,64 +53,63 @@ sub open { } sub clone_winsize_from { - my ($self, $fh) = @_; - croak "Given filehandle is not a tty in clone_winsize_from, called" - if not POSIX::isatty($fh); - return 1 if not POSIX::isatty($self); # ignored for master ptys - my $winsize = " "x1024; # preallocate memory - ioctl($fh, &IO::Tty::Constant::TIOCGWINSZ, $winsize) - and ioctl($self, &IO::Tty::Constant::TIOCSWINSZ, $winsize) + my ( $self, $fh ) = @_; + croak "Given filehandle is not a tty in clone_winsize_from, called" + if not POSIX::isatty($fh); + return 1 if not POSIX::isatty($self); # ignored for master ptys + my $winsize = " " x 1024; # preallocate memory + ioctl( $fh, &IO::Tty::Constant::TIOCGWINSZ, $winsize ) + and ioctl( $self, &IO::Tty::Constant::TIOCSWINSZ, $winsize ) and return 1; - warn "clone_winsize_from: error: $!" if $^W; - return undef; + warn "clone_winsize_from: error: $!" if $^W; + return undef; } # ioctl() doesn't tell us how long the structure is, so we'll have to trim it # after TIOCGWINSZ -my $SIZEOF_WINSIZE = length IO::Tty::pack_winsize(0,0,0,0); +my $SIZEOF_WINSIZE = length IO::Tty::pack_winsize( 0, 0, 0, 0 ); sub get_winsize { - my $self = shift; - ioctl($self, IO::Tty::Constant::TIOCGWINSZ(), my $winsize = q<>) - or croak "Cannot TIOCGWINSZ - $!"; - substr($winsize, $SIZEOF_WINSIZE) = ""; - return IO::Tty::unpack_winsize($winsize); + my $self = shift; + ioctl( $self, IO::Tty::Constant::TIOCGWINSZ(), my $winsize = q<> ) + or croak "Cannot TIOCGWINSZ - $!"; + substr( $winsize, $SIZEOF_WINSIZE ) = ""; + return IO::Tty::unpack_winsize($winsize); } sub set_winsize { - my $self = shift; - my $winsize = IO::Tty::pack_winsize(@_); - ioctl($self, IO::Tty::Constant::TIOCSWINSZ(), $winsize) - or croak "Cannot TIOCSWINSZ - $!"; + my $self = shift; + my $winsize = IO::Tty::pack_winsize(@_); + ioctl( $self, IO::Tty::Constant::TIOCSWINSZ(), $winsize ) + or croak "Cannot TIOCSWINSZ - $!"; } sub set_raw($) { - require POSIX; - my $self = shift; - return 1 if not POSIX::isatty($self); - my $ttyno = fileno($self); - my $termios = new POSIX::Termios; - unless ($termios) { - warn "set_raw: new POSIX::Termios failed: $!"; - return undef; - } - unless ($termios->getattr($ttyno)) { - warn "set_raw: getattr($ttyno) failed: $!"; - return undef; - } - $termios->setiflag(0); - $termios->setoflag(0); - $termios->setlflag(0); - $termios->setcc(&POSIX::VMIN, 1); - $termios->setcc(&POSIX::VTIME, 0); - unless ($termios->setattr($ttyno, &POSIX::TCSANOW)) { - warn "set_raw: setattr($ttyno) failed: $!"; - return undef; - } - return 1; + require POSIX; + my $self = shift; + return 1 if not POSIX::isatty($self); + my $ttyno = fileno($self); + my $termios = new POSIX::Termios; + unless ($termios) { + warn "set_raw: new POSIX::Termios failed: $!"; + return undef; + } + unless ( $termios->getattr($ttyno) ) { + warn "set_raw: getattr($ttyno) failed: $!"; + return undef; + } + $termios->setiflag(0); + $termios->setoflag(0); + $termios->setlflag(0); + $termios->setcc( &POSIX::VMIN, 1 ); + $termios->setcc( &POSIX::VTIME, 0 ); + unless ( $termios->setattr( $ttyno, &POSIX::TCSANOW ) ) { + warn "set_raw: setattr($ttyno) failed: $!"; + return undef; + } + return 1; } - 1; __END__ diff --git a/t/pty_get_winsize.t b/t/pty_get_winsize.t old mode 100755 new mode 100644 index beb04ae..a55f9a5 --- a/t/pty_get_winsize.t +++ b/t/pty_get_winsize.t @@ -6,10 +6,10 @@ use warnings; use Test::More; if ( $^O =~ m!^(solaris|nto)$! ) { - plan skip_all => 'Problems on Solaris and QNX with this test'; + plan skip_all => 'Problems on Solaris and QNX with this test'; } else { - plan tests => 1; + plan tests => 1; } use IO::Pty (); diff --git a/t/test.t b/t/test.t index 6187ea4..f61a978 100644 --- a/t/test.t +++ b/t/test.t @@ -30,29 +30,29 @@ diag("TCSETCTTY") if defined TCSETCTTY; close STDIN; close STDOUT; my $master = new IO::Pty; - my $slave = $master->slave(); - + my $slave = $master->slave(); + my $master_fileno = $master->fileno; - my $slave_fileno = $slave->fileno; - + my $slave_fileno = $slave->fileno; + $master->close(); - if ($master_fileno < 3 or $slave_fileno < 3) { # altered - die("ERROR: masterfd=$master_fileno, slavefd=$slave_fileno"); # altered + if ( $master_fileno < 3 or $slave_fileno < 3 ) { # altered + die("ERROR: masterfd=$master_fileno, slavefd=$slave_fileno"); # altered } exit(0); } is( wait, $pid, "fork exits with 0 exit code" ) or die("Wrong child"); - is( $?, 0, "0 exit code from forked child - Checking that returned fd's don't clash with stdin/out/err" ); + is( $?, 0, "0 exit code from forked child - Checking that returned fd's don't clash with stdin/out/err" ); } { diag(" === Checking if child gets pty as controlling terminal"); - + my $master = new IO::Pty; pipe( FROM_CHILD, TO_PARENT ) - or die "Cannot create pipe: $!"; + or die "Cannot create pipe: $!"; my $pid = fork(); die "Cannot fork" if not defined $pid; unless ($pid) { @@ -85,11 +85,11 @@ diag("TCSETCTTY") if defined TCSETCTTY; close FROM_CHILD; my ( $s, $chunk ); - $SIG{ALRM} = sub { die("Timeout ($s)");}; + $SIG{ALRM} = sub { die("Timeout ($s)"); }; alarm(10); sysread( $master, $s, 100 ) or die "sysread() failed: $!"; - like($s, qr/gimme.*:/ , "master object outputs: '$s'"); + like( $s, qr/gimme.*:/, "master object outputs: '$s'" ); print $master "seems OK!\n"; @@ -98,7 +98,7 @@ diag("TCSETCTTY") if defined TCSETCTTY; while ( $ret = sysread( $master, $chunk, 100 ) ) { $s .= $chunk; } - like($s, qr/back on STDOUT: SEEMS OK!/, "STDOUT looks right"); + like( $s, qr/back on STDOUT: SEEMS OK!/, "STDOUT looks right" ); warn <<"_EOT_" unless defined $ret; WARNING: when the client closes the slave pty, the master gets an error @@ -113,15 +113,18 @@ _EOT_ } # now for the echoback tests -diag("Checking basic functionality and how your ptys handle large strings... +diag( + "Checking basic functionality and how your ptys handle large strings... This test may hang on certain systems, even though it is protected - by alarm(). If the counter stops, try Ctrl-C, the test should continue."); + by alarm(). If the counter stops, try Ctrl-C, the test should continue." +); { - my $randstring = q{fakjdf ijj845jtirg\r8e 4jy8 gfuoyhj\agt8h\0x00 gues98\0xFF 45th guoa\beh gt98hae 45t8u ha8rhg ue4ht 8eh tgo8he4 t8 gfj aoingf9a8hgf uain dgkjadshft+uehgf =usüand9ß87vgh afugh 8*h 98H 978H 7HG zG 86G (&g (O/g &(GF(/EG F78G F87SG F(/G F(/a sldjkf ha\@j<\rksdhf jk>~|ahsd fjkh asdHJKGDSG TRJKSGO JGDSFJDFHJGSDK1%&FJGSDGFSH\0xADJäDGFljkhf lakjs(dh fkjahs djfk hasjkdh fjklahs dfkjhdjkf haöjksdh fkjah sdjf)\$/§&k hasÄÜÖjkdh fkjhuerhtuwe htui eruth ZI AHD BIZA Di7GH )/g98 9 97 86tr(& TA&(t 6t &T 75r 5\$R%/4r76 5&/% R79 5 )/&}; + my $randstring = + q{fakjdf ijj845jtirg\r8e 4jy8 gfuoyhj\agt8h\0x00 gues98\0xFF 45th guoa\beh gt98hae 45t8u ha8rhg ue4ht 8eh tgo8he4 t8 gfj aoingf9a8hgf uain dgkjadshft+uehgf =usüand9ß87vgh afugh 8*h 98H 978H 7HG zG 86G (&g (O/g &(GF(/EG F78G F87SG F(/G F(/a sldjkf ha\@j<\rksdhf jk>~|ahsd fjkh asdHJKGDSG TRJKSGO JGDSFJDFHJGSDK1%&FJGSDGFSH\0xADJäDGFljkhf lakjs(dh fkjahs djfk hasjkdh fjklahs dfkjhdjkf haöjksdh fkjah sdjf)\$/§&k hasÄÜÖjkdh fkjhuerhtuwe htui eruth ZI AHD BIZA Di7GH )/g98 9 97 86tr(& TA&(t 6t &T 75r 5\$R%/4r76 5&/% R79 5 )/&}; my $master = new IO::Pty; - diag("isatty(\$master): ", POSIX::isatty($master) ? "YES" : "NO"); + diag( "isatty(\$master): ", POSIX::isatty($master) ? "YES" : "NO" ); if ( POSIX::isatty($master) ) { $master->set_raw() or warn "warning: \$master->set_raw(): $!"; @@ -137,7 +140,7 @@ diag("Checking basic functionality and how your ptys handle large strings... my $c; my $slave = $master->slave(); close $master; - diag("isatty(\$slave): ", POSIX::isatty($slave) ? "YES" : "NO"); + diag( "isatty(\$slave): ", POSIX::isatty($slave) ? "YES" : "NO" ); $slave->set_raw() or warn "warning: \$slave->set_raw(): $!"; close FROM_CHILD; @@ -148,7 +151,7 @@ diag("Checking basic functionality and how your ptys handle large strings... while (1) { my $ret = sysread( $slave, $c, 1 ); - warn "sysread(): $!" unless defined $ret; + warn "sysread(): $!" unless defined $ret; die "Slave got EOF at line $linecnt, byte $cnt.\n" unless $ret; $cnt++; if ( $c eq "\n" ) { @@ -229,10 +232,9 @@ _EOT_ else { diag("Good, your raw ptys can handle at least $maxlen bytes at once."); } - ok( $maxlen >= 200, "\$maxlen >= 200 ($maxlen)"); + ok( $maxlen >= 200, "\$maxlen >= 200 ($maxlen)" ); close($master); sleep(1); kill TERM => $pid; } -