#!/usr/bin/env perl use strict; use warnings; use autodie; use constant CANCEL_BYTES => ( ((24) x 5), ((8) x 5), #0, ); use constant ZCAN_BYTES => ( 42, 42, 24, 66, 49, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 52, 53, 97, 13, 10, 17 ); use constant VERBOSE => '-vvvvvvvvvvvv'; use feature 'say'; use IO::Poll (); use File::Temp (); use File::Which (); use Text::Control (); my $COMMAND = 'sz'; #my @verbose_flags = ( VERBOSE() ); my @verbose_flags = (); my $size = 2**24; my $file_content = ('x' x $size) . '=THE END'; my $cmd_path = File::Which::which($COMMAND) or die "Need “$COMMAND”!"; #$cmd_path = '/Users/felipe/code/lrzsz/src/lsz'; my ($tfh, $tpath) = File::Temp::tempfile( CLEANUP => 1 ); print "temp file path: $tpath\n"; syswrite $tfh, $file_content; close $tfh; pipe( my $pr, my $cw ); pipe( my $cr, my $pw ); my $pid = fork or do { close $_ for ($pr, $pw); open \*STDIN, '<&=', $cr; open \*STDOUT, '>>&=', $cw; exec $cmd_path, @verbose_flags, $tpath or die $!; }; close $_ for ($cr, $cw); $pr->blocking(0); my $poll = IO::Poll->new(); $poll->mask( $pr, IO::Poll::POLLIN() ); sub _poll_in { return $poll->poll(30) || die 'Timed out on read!'; } sub _read { _poll_in(); my $buf = q<>; sysread( $pr, $buf, 4096, length $buf ); #it’ll never be that big return $buf; } sub _read_and_report { my $input = _read(); _report_from_child($input); } sub _report_from_child { my $bytes = $_[0]; my $truncated_yn; my $orig_len = length $bytes; if ($orig_len > 70) { substr($bytes, 25) = q<>; $truncated_yn = 1; } $bytes = Text::Control::to_hex($bytes); if ($truncated_yn) { $bytes .= ' … ' . Text::Control::to_hex( substr($_[0], -45) ); $bytes .= " ($orig_len bytes)"; } say "$COMMAND says: $bytes"; } sub _write { syswrite $pw, $_[0]; } sub _write_octets { my $bytes = join( q<>, map { chr } @_ ); _write( $bytes ); say "to $COMMAND: " . Text::Control::to_hex($bytes); } sub _write_and_wait_to_finish { _write_octets(@_); _wait_to_finish(); } sub _wait_to_finish { close $pw; $pr->blocking(1); my $buf = q<>; while (my $read = sysread $pr, $buf, 65536) { if ($buf =~ m<=THE END>) { print STDERR "\x07XXXXX FAILED TO STOP THE ONSLAUGHT!!\n"; sleep 2; } print "=========== FINAL ($read) ===========\n"; _report_from_child($buf); } close $pr; waitpid $pid, 0; my $exit = $? >> 8; print "$COMMAND exit: $exit\n"; exit; } sub _send_cancel { print "======= SENDING CANCEL\n"; _write_and_wait_to_finish( CANCEL_BYTES() ); } sub _read_until_packet_end { my $buf = q<>; my $next_header; while (1) { if ($buf =~ m<\x18h..(.*)>) { $next_header = $1; last; } _poll_in(); sysread $pr, $buf, 65536, length $buf; } print "\nEnd of packet\n"; _report_from_child($next_header) if length $next_header; return; } sub _send_ZCAN { print "======= SENDING ZCAN\n"; _write_and_wait_to_finish( ZCAN_BYTES() ); } #---------------------------------------------------------------------- #Shows ZRQINIT _read_and_report(); #_send_cancel(); #works #_send_ZCAN(); #doesn’t work use constant ZRINIT_BYTES => ( #CANOVIO, CANFDX #42, 42, 24, 66, 48, 49, 48, 48, 48, 48, 48, 48, 48, 48, 97, 97, 53, 49, 13, 10, 17, #CANOVIO, CANFDX, CANFC32 qw( 42 42 24 66 48 49 48 48 48 48 48 48 50 51 98 101 53 48 13 10 17 ), ); use constant ZSKIP_BYTES => ( 42, 42, 24, 66, 48, 53, 48, 48, 48, 48, 48, 48, 48, 48, 50, 51, 53, 55, 13, 10, 17, ); #ZRINIT _write_octets( ZRINIT_BYTES() ); #Shows ZFILE and offer subpacket _read_and_report(); #_send_cancel(); #works #_send_ZCAN(); #works #ZRPOS _write_octets( 42, 42, 24, 66, 48, 57, 48, 48, 48, 48, 48, 48, 48, 48, 97, 56, 55, 99, 13, 10, 17 ); #Shows initial batch of file data #_read_and_report(); # #_send_ZCAN(); #works - BUFFER OVERFLOW _send_cancel(); #works - BUFFER OVERFLOW _read_and_report(); #_write_octets( ZSKIP_BYTES() ); #_read_until_packet_end(); #_send_cancel(); #works #ZRINIT _write_octets( ZRINIT_BYTES() ); #_send_cancel(); #works _read_and_report(); _send_cancel(); #works - but by this point the transfer is done #ZFIN _write_octets( 42, 42, 24, 66, 48, 56, 48, 48, 48, 48, 48, 48, 48, 48, 48, 50, 50, 100, 13, 10 ); _wait_to_finish();