BBS-Universal
view release on metacpan or search on metacpan
lib/BBS/Universal/FileTransfer.pm view on Meta::CPAN
$self->{'debug'}->DEBUG(['Start files_receive_file_xmodem']);
my $sock = $self->{'cl_socket'};
unless ($sock) {
$self->{'debug'}->ERROR(["No client socket for XMODEM receive"]);
return 0;
}
$self->output("\nStart sending your file via Xmodem\n");
my $path = $file;
my $FH;
# Ensure directory exists
if ($path =~ m{^(.+)/[^/]+$}) {
my $dir = $1;
unless (-d $dir) {
File::Path::mkpath($dir);
}
} ## end if ($path =~ m{^(.+)/[^/]+$})
unless (open $FH, '>:raw', $path) {
$self->{'debug'}->ERROR(["Cannot open file for writing $path: $!"]);
return 0;
}
my $expected_blk = 1;
my $max_init_tries = 10;
my $init_sent = 0;
# Request CRC mode by sending 'C' until sender responds with SOH/STX/EOT
for (1 .. $max_init_tries) {
last unless $self->is_connected();
syswrite($sock, C_CHAR);
$init_sent++;
my $b = $self->_read_byte_timeout($sock, 10);
if (defined $b && ($b eq SOH || $b eq STX || $b eq EOT || $b eq CAN)) {
# put back the byte into variable for main loop
$self->{'_xmodem_first'} = $b;
last;
} ## end if (defined $b && ($b ...))
} ## end for (1 .. $max_init_tries)
unless ($init_sent) {
$self->{'debug'}->ERROR(["No response from sender to XMODEM init"]);
close $FH;
return 0;
}
my $success = 1;
FILE_LOOP:
while ($self->is_connected()) {
# read first header byte
my $hdr;
if (defined $self->{'_xmodem_first'}) {
$hdr = delete $self->{'_xmodem_first'};
} else {
$hdr = $self->_read_byte_timeout($sock, 60);
}
unless (defined $hdr) {
$self->{'debug'}->ERROR(["Timeout waiting for XMODEM block header"]);
$success = 0;
last;
}
if ($hdr eq EOT) {
# End of transmission
syswrite($sock, ACK);
last FILE_LOOP;
} elsif ($hdr eq CAN) {
$self->{'debug'}->ERROR(["Sender cancelled XMODEM transfer (CAN)"]);
$success = 0;
last FILE_LOOP;
} elsif ($hdr eq SOH || $hdr eq STX) {
my $block_size = ($hdr eq STX) ? 1024 : 128;
# read blocknum and its complement
my $blknum = $self->_read_byte_timeout($sock, 10);
my $nblk = $self->_read_byte_timeout($sock, 10);
unless (defined $blknum && defined $nblk) {
$self->{'debug'}->ERROR(["Timeout reading block number for XMODEM"]);
$success = 0;
last FILE_LOOP;
}
my $blknum_val = ord($blknum);
my $nblk_val = ord($nblk);
# read data
my $data = '';
for (1 .. $block_size) {
my $b = $self->_read_byte_timeout($sock, 10);
unless (defined $b) {
$self->{'debug'}->ERROR(["Timeout reading XMODEM data block"]);
$success = 0;
last FILE_LOOP;
}
$data .= $b;
} ## end for (1 .. $block_size)
# read CRC16 (2 bytes)
my $crc_hi = $self->_read_byte_timeout($sock, 10);
my $crc_lo = $self->_read_byte_timeout($sock, 10);
unless (defined $crc_hi && defined $crc_lo) {
$self->{'debug'}->ERROR(["Timeout reading XMODEM CRC"]);
$success = 0;
last FILE_LOOP;
}
my $recv_crc = $crc_hi . $crc_lo;
# validate block number
if ((($blknum_val + ord($nblk)) & 0xFF) != 0xFF) {
# invalid complement
$self->{'debug'}->ERROR(["Invalid block number complement in XMODEM block"]);
syswrite($sock, NAK);
next;
} ## end if ((($blknum_val + ord...)))
if ($blknum_val == ($expected_blk & 0xFF)) {
# verify CRC
my $calc_crc = _crc16_bytes($data);
if ($calc_crc eq $recv_crc) {
# write data (for XMODEM we don't have exact file size; write all and later trim if needed)
# strip trailing SUB (0x1A) only when they appear at the end if sender padded
# We'll write raw data; caller may handle size if needed.
print $FH $data;
syswrite($sock, ACK);
$expected_blk = ($expected_blk + 1) & 0xFF;
} else {
$self->{'debug'}->ERROR(["CRC mismatch on XMODEM block $blknum_val"]);
syswrite($sock, NAK);
next;
}
} elsif ($blknum_val == (($expected_blk - 1) & 0xFF)) {
# duplicate block (sender retransmitted) - ACK and ignore
syswrite($sock, ACK);
next;
} else {
# out of sequence
$self->{'debug'}->ERROR(["Unexpected XMODEM block number $blknum_val (expected $expected_blk)"]);
syswrite($sock, CAN x 2);
$success = 0;
last FILE_LOOP;
} ## end else [ if ($blknum_val == ($expected_blk...))]
} else {
# unexpected byte - ignore/continue
$self->{'debug'}->DEBUG(["Received unexpected byte during XMODEM receive: " . ord($hdr)]);
next;
} ## end else [ if ($hdr eq EOT) ]
} ## end FILE_LOOP: while ($self->is_connected...)
close $FH;
$self->output("\nFile receive complete\n");
$self->{'debug'}->DEBUG(['End files_receive_file_xmodem']);
return $success;
} ## end sub files_receive_file_xmodem
sub files_receive_file_ymodem {
my ($self, $file) = @_;
$self->{'debug'}->DEBUG(['Start files_receive_file_ymodem']);
my $sock = $self->{'cl_socket'};
unless ($sock) {
$self->{'debug'}->ERROR(["No client socket for YMODEM receive"]);
return 0;
}
lib/BBS/Universal/FileTransfer.pm view on Meta::CPAN
$self->output("\nStart sending your file via Ymodem\n");
my $path = $file;
# Ensure directory exists
if ($path =~ m{^(.+)/[^/]+$}) {
my $dir = $1;
unless (-d $dir) {
File::Path::mkpath($dir);
}
} ## end if ($path =~ m{^(.+)/[^/]+$})
my $FH;
unless (open $FH, '>:raw', $path) {
$self->{'debug'}->ERROR(["Cannot open file for writing $path: $!"]);
return 0;
}
# Request CRC for YMODEM by sending 'C' to start
my $tries = 0;
my $init_ok = 0;
for (1 .. 10) {
last unless $self->is_connected();
syswrite($sock, C_CHAR);
my $b = $self->_read_byte_timeout($sock, 10);
if (defined $b) {
# If we immediately get SOH/STX as response, proceed (put it back)
if ($b eq SOH || $b eq STX || $b eq CAN) {
$self->{'_ymodem_first'} = $b;
$init_ok = 1;
last;
} else {
# continue waiting for block 0
$init_ok = 1;
last;
} ## end else [ if ($b eq SOH || $b eq...)]
} ## end if (defined $b)
$tries++;
} ## end for (1 .. 10)
unless ($init_ok) {
$self->{'debug'}->ERROR(["No response from sender to YMODEM init"]);
close $FH;
return 0;
}
my $expected_blk = 0; # header block is block 0
my $filesize = undef;
my $success = 1;
my $writing = 0;
my $bytes_written = 0;
HEADER_LOOP:
while ($self->is_connected()) {
# read header/block
my $hdr;
if (defined $self->{'_ymodem_first'}) {
$hdr = delete $self->{'_ymodem_first'};
} else {
$hdr = $self->_read_byte_timeout($sock, 60);
}
unless (defined $hdr) {
$self->{'debug'}->ERROR(["Timeout waiting for YMODEM block header"]);
$success = 0;
last HEADER_LOOP;
}
if ($hdr eq CAN) {
$self->{'debug'}->ERROR(["Sender cancelled YMODEM transfer (CAN)"]);
$success = 0;
last HEADER_LOOP;
} elsif ($hdr eq EOT) {
# Should not occur before data; but handle: ack and finish
syswrite($sock, ACK);
last HEADER_LOOP;
} elsif ($hdr eq SOH || $hdr eq STX) {
my $block_size = ($hdr eq STX) ? 1024 : 128;
my $blknum = $self->_read_byte_timeout($sock, 10);
my $nblk = $self->_read_byte_timeout($sock, 10);
unless (defined $blknum && defined $nblk) {
$self->{'debug'}->ERROR(["Timeout reading block number for YMODEM"]);
$success = 0;
last HEADER_LOOP;
}
my $blknum_val = ord($blknum);
# read data
my $data = '';
for (1 .. $block_size) {
my $b = $self->_read_byte_timeout($sock, 10);
unless (defined $b) {
$self->{'debug'}->ERROR(["Timeout reading YMODEM data block"]);
$success = 0;
last HEADER_LOOP;
}
$data .= $b;
} ## end for (1 .. $block_size)
# read CRC16
my $crc_hi = $self->_read_byte_timeout($sock, 10);
my $crc_lo = $self->_read_byte_timeout($sock, 10);
unless (defined $crc_hi && defined $crc_lo) {
$self->{'debug'}->ERROR(["Timeout reading YMODEM CRC"]);
$success = 0;
last HEADER_LOOP;
}
my $recv_crc = $crc_hi . $crc_lo;
my $calc_crc = _crc16_bytes($data);
if ($calc_crc ne $recv_crc) {
$self->{'debug'}->ERROR(["CRC mismatch on YMODEM block $blknum_val"]);
syswrite($sock, NAK);
next;
}
if ($blknum_val == $expected_blk) {
if ($expected_blk == 0) {
# header block: filename\0size\0
my ($fname, $size_str) = split(/\0/, $data, 3);
if (defined $fname && $fname ne '') {
# parse size
if (defined $size_str && $size_str =~ /(\d+)/) {
$filesize = $1 + 0;
}
# we will use the provided $path (from caller). If needed, one could use $fname instead.
$writing = 1;
# ack header and request CRC for data blocks
syswrite($sock, ACK);
syswrite($sock, C_CHAR);
$expected_blk = 1;
next;
} else {
# empty filename => end of batch
syswrite($sock, ACK);
last HEADER_LOOP;
} ## end else [ if (defined $fname && ...)]
} else {
# data block
if ($writing) {
# if filesize known, write only up to remaining bytes
if (defined $filesize) {
my $remaining = $filesize - $bytes_written;
if ($remaining <= 0) {
# already have enough data; ack and ignore
} else {
my $to_write = $data;
if (length($to_write) > $remaining) {
$to_write = substr($to_write, 0, $remaining);
}
print $FH $to_write;
$bytes_written += length($to_write);
} ## end else [ if ($remaining <= 0) ]
} else {
print $FH $data;
$bytes_written += length($data);
}
} ## end if ($writing)
syswrite($sock, ACK);
$expected_blk = ($expected_blk + 1) & 0xFF;
next;
} ## end else [ if ($expected_blk == 0)]
} elsif ($blknum_val == (($expected_blk - 1) & 0xFF)) {
# duplicate block - ack and continue
lib/BBS/Universal/FileTransfer.pm view on Meta::CPAN
my ($self, $sock, $timeout) = @_;
$timeout ||= 10;
my $rin = '';
my $rout;
my $fileno = fileno($sock);
return undef unless defined $fileno && $fileno >= 0;
vec($rin, $fileno, 1) = 1;
my $nfound = select($rout = $rin, undef, undef, $timeout);
if ($nfound > 0) {
my $buf = '';
my $r = sysread($sock, $buf, 1);
return undef unless defined $r && $r == 1;
return $buf;
} ## end if ($nfound > 0)
return undef;
} ## end sub _read_byte_timeout
# Send a single XMODEM/YMODEM block (128 or 1024) using CRC16
sub _send_block {
my ($self, $sock, $blknum, $data, $block_size) = @_;
$block_size ||= 128;
my $hdr = ($block_size == 1024) ? STX : SOH;
$data .= chr(0x1A) x ($block_size - length($data)); # pad with SUB
my $blk = $hdr . chr($blknum & 0xFF) . chr((~$blknum) & 0xFF) . $data;
$blk .= _crc16_bytes($data);
my $written = 0;
my $len = length($blk);
while ($written < $len && $self->is_connected()) {
my $rv = syswrite($sock, substr($blk, $written), $len - $written);
unless (defined $rv) {
return 0;
}
$written += $rv;
} ## end while ($written < $len &&...)
return 1;
} ## end sub _send_block
# XMODEM send (CRC mode preferred)
# Returns true on success, false on failure
sub files_send_xmodem {
my ($self, $file) = @_;
$self->{'debug'}->DEBUG(['Start files_send_xmodem']);
my $sock = $self->{'cl_socket'};
unless ($sock) {
$self->{'debug'}->ERROR(["No client socket for XMODEM send"]);
return 0;
}
$self->output("\nStart Xmodem download\n");
my $path = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file;
my $FH;
unless (open $FH, '<:raw', $path) {
$self->{'debug'}->ERROR(["Cannot open file $path: $!"]);
return 0;
}
# Wait for receiver request: 'C' (CRC) or NAK (checksum)
my $init_char = _read_byte_timeout($sock, 60);
unless (defined $init_char) {
$self->{'debug'}->ERROR(["Timeout waiting for receiver to start XMODEM"]);
close $FH;
return 0;
}
my $use_crc = ($init_char eq C_CHAR);
# we will always use CRC16 blocks
my $blockno = 1;
my $success = 1;
my $retries_global = 0;
my $eof = 0;
my $max_retries = 10;
while ($self->is_connected()) {
my $data;
my $n = read($FH, $data, 128);
if (defined $n && $n > 0) {
# send block
my $send_ok = 0;
my $attempts = 0;
while ($attempts < $max_retries && $self->is_connected()) {
$attempts++;
unless ($self->_send_block($sock, $blockno, $data, 128)) {
$self->{'debug'}->ERROR(["Failed write while sending XMODEM block $blockno"]);
$success = 0;
last;
}
my $resp = $self->_read_byte_timeout($sock, 10);
unless (defined $resp) {
$self->{'debug'}->DEBUG(["No response for block $blockno, retry $attempts"]);
next;
}
if ($resp eq ACK) {
$send_ok = 1;
last;
} elsif ($resp eq NAK) {
next; # retransmit
} elsif ($resp eq CAN) {
$self->{'debug'}->ERROR(["Received CAN during XMODEM send"]);
$success = 0;
last;
} else {
# unexpected byte, retry
next;
}
} ## end while ($attempts < $max_retries...)
unless ($send_ok) { $success = 0; last; }
$blockno = ($blockno + 1) % 256;
} else {
# EOF reached
$eof = 1;
last;
} ## end else [ if (defined $n && $n >...)]
} ## end while ($self->is_connected...)
if ($success) {
# send EOT and wait for ACK
my $sent = 0;
for (1 .. 10) {
syswrite($sock, EOT);
my $r = $self->_read_byte_timeout($sock, 10);
if (defined $r && $r eq ACK) { $sent = 1; last; }
}
unless ($sent) {
$self->{'debug'}->ERROR(["No ACK for EOT in XMODEM send"]);
$success = 0;
} else {
$self->{'debug'}->DEBUG(['XMODEM send completed']);
}
} ## end if ($success)
close $FH;
$self->output("\nFile download complete\n");
$self->{'debug'}->DEBUG(['End files_send_xmodem']);
return $success;
} ## end sub files_send_xmodem
# YMODEM send (simple implementation):
# - Send initial 128-byte header block with filename\0size\0
# - Then send data in 1024-byte STX blocks with CRC16
# Returns true on success, false otherwise
sub files_send_ymodem {
my ($self, $file) = @_;
$self->{'debug'}->DEBUG(['Start files_send_ymodem']);
my $sock = $self->{'cl_socket'};
unless ($sock) {
$self->{'debug'}->ERROR(["No client socket for YMODEM send"]);
return 0;
}
$self->output("\nStart Ymodem download\n");
my $path = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file;
my $FH;
unless (open $FH, '<:raw', $path) {
$self->{'debug'}->ERROR(["Cannot open file $path: $!"]);
return 0;
}
my $size = -s $path;
$size = 0 unless defined $size;
# Wait for initial 'C' (CRC) from receiver
my $init_char = $self->_read_byte_timeout($sock, 60);
unless (defined $init_char) {
$self->{'debug'}->ERROR(["Timeout waiting for receiver to start YMODEM"]);
close $FH;
return 0;
}
# prepare header block (block 0)
my $header = $file . "\0" . $size . " ";
$header .= "\0" x (128 - length($header));
# send header block and expect ACK then 'C'
unless ($self->_send_block($sock, 0, $header, 128)) {
$self->{'debug'}->ERROR(["Failed to send YMODEM header block"]);
close $FH;
return 0;
}
my $r1 = $self->_read_byte_timeout($sock, 10);
my $r2 = $self->_read_byte_timeout($sock, 10);
# r1 should be ACK and r2 should be 'C' to begin 1k transfer (some receivers differ)
unless (defined $r1 && $r1 eq ACK) {
$self->{'debug'}->ERROR(["No ACK after YMODEM header"]);
close $FH;
return 0;
}
# Send data blocks in 1K (1024) with STX header
my $blockno = 1;
my $success = 1;
while ($self->is_connected()) {
my $data;
my $n = read($FH, $data, 1024);
if (defined $n && $n > 0) {
# send 1k block
my $attempts = 0;
my $sent_ok = 0;
while ($attempts < 10 && $self->is_connected()) {
$attempts++;
unless ($self->_send_block($sock, $blockno, $data, 1024)) {
$self->{'debug'}->ERROR(["Failed write while sending YMODEM block $blockno"]);
$success = 0;
last;
}
my $resp = $self->_read_byte_timeout($sock, 10);
if (defined $resp && $resp eq ACK) { $sent_ok = 1; last; }
if (defined $resp && $resp eq NAK) { next; }
if (defined $resp && $resp eq CAN) { $self->{'debug'}->ERROR(["Received CAN during YMODEM send"]); $success = 0; last; }
# else retry
} ## end while ($attempts < 10 && ...)
last unless $sent_ok && $success;
$blockno = ($blockno + 1) % 256;
} else {
last; # EOF
}
} ## end while ($self->is_connected...)
if ($success) {
# End-of-file sequence: send EOT and expect ACK, then send an empty header block (block 0 with filename "")
my $sent = 0;
for (1 .. 10) {
syswrite($sock, EOT);
( run in 2.168 seconds using v1.01-cache-2.11-cpan-2398b32b56e )