BBS-Universal
view release on metacpan or search on metacpan
print 'Loading ' . $MAX_THREADS . ' Threads ...';
$socket = IO::Socket->new(
'Domain' => AF_INET,
'LocalHost' => $bbs_obj->{'CONF'}->{'HOST'},
'LocalPort' => $bbs_obj->{'CONF'}->{'PORT'},
'Type' => SOCK_STREAM,
'Proto' => 'tcp',
'Listen' => 1,
'ReuseAddr' => TRUE,
'ReusePort' => TRUE,
'Timeout' => 1,
'Blocking' => FALSE,
);
my $error = undef;
$error = "Cannot create socket for $!n" unless ($socket);
if (defined($error)) {
$DEBUG->ERROR([$error, 'Local Mode Only']);
sleep 5;
} else {
foreach my $thread (1 .. $MAX_THREADS) {
my $name = sprintf('TH_%02d', $thread);
lib/BBS/Universal.pm view on Meta::CPAN
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);
lib/BBS/Universal.pm view on Meta::CPAN
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;
}
lib/BBS/Universal.pm view on Meta::CPAN
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;
lib/BBS/Universal.pm view on Meta::CPAN
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)) {
lib/BBS/Universal/FileTransfer.pm view on Meta::CPAN
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);
lib/BBS/Universal/FileTransfer.pm view on Meta::CPAN
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;
}
lib/BBS/Universal/FileTransfer.pm view on Meta::CPAN
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;
lib/BBS/Universal/FileTransfer.pm view on Meta::CPAN
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)) {
( run in 1.924 second using v1.01-cache-2.11-cpan-2398b32b56e )