BBS-Universal
view release on metacpan or search on metacpan
lib/BBS/Universal/FileTransfer.pm view on Meta::CPAN
package BBS::Universal::FileTransfer;
BEGIN { our $VERSION = '0.008'; }
sub filetransfer_initialize {
my ($self) = @_;
$self->{'debug'}->DEBUG(['Start FileTransfer Initialize']);
$self->{'debug'}->DEBUG(['End FileTransfer Initialize']);
return ($self);
} ## end sub filetransfer_initialize
sub files_type {
my ($self, $file) = @_;
$self->{'debug'}->DEBUG(['Start File Type']);
my @tmp = split(/\./, $file);
my $ext = uc(pop(@tmp));
my $sth = $self->{'dbh'}->prepare('SELECT type FROM file_types WHERE extension=?');
$sth->execute($ext);
my $name;
if ($sth->rows > 0) {
$name = $sth->fetchrow_array();
}
$sth->finish();
$self->{'debug'}->DEBUG(['End File Type']);
return ($ext, $name);
} ## end sub files_type
sub files_load_file {
my ($self, $file) = @_;
$self->{'debug'}->DEBUG(['Start Files Load File']);
my $filename = sprintf('%s.%s', $file, $self->{'USER'}->{'text_mode'});
$self->{'CACHE'}->set(sprintf('SERVER %02d %s', $self->{'thread_number'}, 'CURRENT MENU FILE'), $filename);
open(my $FILE, '<', $filename);
my @text = <$FILE>;
close($FILE);
chomp(@text);
$self->{'debug'}->DEBUG(['End Files Load File']);
return (join("\n", @text));
} ## end sub files_load_file
sub files_list_summary {
my ($self, $search) = @_;
$self->{'debug'}->DEBUG(['Start Files List Summary']);
my $sth;
my $filter;
if ($search) {
$self->prompt('Search for (blank for all)');
$filter = $self->get_line({ 'type' => STRING, 'max' => 255, 'default' => '' });
$sth = $self->{'dbh'}->prepare('SELECT * FROM files_view WHERE (filename LIKE ? OR title LIKE ?) AND category_id=? ORDER BY uploaded DESC');
$sth->execute('%' . $filter . '%', '%' . $filter . '%', $self->{'USER'}->{'file_category'});
} else {
$sth = $self->{'dbh'}->prepare('SELECT * FROM files_view WHERE category_id=? ORDER BY uploaded DESC');
$sth->execute($self->{'USER'}->{'file_category'});
}
my @files;
my $max_filename = 10;
my $max_title = 20;
if ($sth->rows > 0) {
while (my $row = $sth->fetchrow_hashref()) {
push(@files, $row);
$max_filename = max(length($row->{'filename'}), $max_filename);
$max_title = max(length($row->{'title'}), $max_title);
}
my $table = Text::SimpleTable->new($max_filename, $max_title);
$table->row('FILENAME', 'TITLE');
$table->hr();
foreach my $record (@files) {
$table->row($record->{'filename'}, $record->{'title'});
}
my $mode = $self->{'USER'}->{'text_mode'};
if ($mode eq 'ANSI') {
my $text = $table->boxes2('MAGENTA')->draw();
while ($text =~ / (FILENAME|TITLE) /s) {
my $ch = $1;
my $new = '[% BRIGHT YELLOW %]' . $ch . '[% RESET %]';
$text =~ s/ $ch / $new /gs;
}
$self->output("\n$text");
} elsif ($mode eq 'ATASCII') {
$self->output("\n" . $self->color_border($table->boxes->draw(), 'MAGENTA'));
} elsif ($mode eq 'PETSCII') {
my $text = $table->boxes->draw();
while ($text =~ / (FILENAME|TITLE) /s) {
my $ch = $1;
my $new = '[% YELLOW %]' . $ch . '[% RESET %]';
$text =~ s/ $ch / $new /gs;
}
$self->output("\n" . $self->color_border($text, 'PURPLE'));
} else {
$self->output("\n" . $table->draw());
}
} elsif ($search) {
$self->output("\nSorry '$filter' not found");
} else {
$self->output("\nSorry, this file category is empty\n");
}
$self->output("\nPress a key to continue ...");
$self->get_key(ECHO, BLOCKING);
$self->{'debug'}->DEBUG(['End Files List Summary']);
return (TRUE);
} ## end sub files_list_summary
sub files_choices {
my ($self, $record) = @_;
while ($self->is_connected()) {
my $view = FALSE;
my $mapping = {
'TEXT' => '',
'Z' => { 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to File Menu' },
'N' => { 'command' => 'NEXT', 'color' => 'BLUE', 'access_level' => 'USER', 'text' => 'Next file' },
'D' => { 'command' => 'DOWNLOAD', 'color' => 'CYAN', 'access_level' => 'VETERAN', 'text' => 'Download file' },
'R' => { 'command' => 'REMOVE FILE', 'color' => 'RED', 'access_level' => 'JUNIOR SYSOP', 'text' => 'Remove file' },
};
if ($record->{'extension'} =~ /^(TXT|ASC|ATA|PET|VT|ANS|MD|INF|CDF|PL|PM|PY|C|CPP|H|SH|CSS|HTM|HTML|SHTML|JS|JAVA|XML|BAT)$/ && $self->check_access_level('VETERAN')) {
$view = TRUE;
$mapping->{'V'} = { 'command' => 'VIEW FILE', 'color' => 'CYAN', 'access_level' => 'VETERAN', 'text' => 'View file' };
} ## end if ($record->{'extension'...})
$self->show_choices($mapping);
$self->prompt('Choose');
my $key;
do {
$key = uc($self->get_key());
} until ($key =~ /D|N|Z/ || ($key eq 'V' && $view) || ($key eq 'R' && $self->check_access_level('JUNION SYSOP')));
$self->output($mapping->{$key}->{'command'} . "\n");
if ($mapping->{$key}->{'command'} eq 'DOWNLOAD') {
my $file = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $record->{'filename'};
$mapping = {
'B' => { 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to File Menu' },
'Y' => { 'command' => 'YMODEM', 'color' => 'YELLOW', 'access_level' => 'VETERAN', 'text' => 'Download with the Ymodem protocol' },
'X' => { 'command' => 'XMODEM', 'color' => 'BRIGHT BLUE', 'access_level' => 'VETERAN', 'text' => 'Download with the Xmodem protocol' },
'Z' => { 'command' => 'ZMODEM', 'color' => 'GREEN', 'access_level' => 'VETERAN', 'text' => 'Download with the Zmodem protocol' },
};
$self->show_choices($mapping);
$self->prompt('Choose');
do {
$key = uc($self->get_key());
} until ($key =~ /B|X|Y|Z/);
$self->output($mapping->{$key}->{'command'});
if ($mapping->{$key}->{'command'} eq 'XMODEM') {
system('sz', '--xmodem', '--quiet', '--binary', $file);
} elsif ($mapping->{$key}->{'command'} eq 'YMODEM') {
system('sz', '--ymodem', '--quiet', '--binary', $file);
} elsif ($mapping->{$key}->{'command'} eq 'ZMODEM') {
system('sz', '--zmodem', '--quiet', '--binary', '--resume', $file);
} else {
return (FALSE);
}
return (TRUE);
} elsif ($mapping->{$key}->{'command'} eq 'VIEW FILE' && $self->check_access_level($mapping->{$key}->{'access_level'})) {
my $file = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $record->{'filename'};
open(my $VIEW, '<', $file);
binmode($VIEW, ":encoding(UTF-8)");
my $data;
read($VIEW, $data, $record->{'file_size'}, 0);
close($VIEW);
$self->output('[% CLS %]' . $data . '[% RESET %]');
} elsif ($mapping->{$key}->{'command'} eq 'REMOVE FILE' && $self->check_access_level($mapping->{$key}->{'access_level'})) {
return (TRUE);
} elsif ($mapping->{$key}->{'command'} eq 'NEXT') {
return (TRUE);
} elsif ($mapping->{$key}->{'command'} eq 'BACK') {
return (FALSE);
}
} ## end while ($self->is_connected...)
} ## end sub files_choices
sub files_upload_choices {
my ($self) = @_;
my $ckey;
$self->prompt('File Name? ');
my $file = $self->get_line({ 'type' => FILENAME, 'max' => 255, 'default' => '' });
my $ext = uc($file =~ /\.(.*?)$/);
$self->prompt('Title (Fiendly name)? ');
my $title = $self->get_line({ 'type' => STRING, 'max' => 255, 'default' => '' });
$self->prompt('Description? ');
my $description = $self->get_line({ 'type' => STRING, 'max' => 255, 'default' => '' });
my $file_category = $self->{'USER'}->{'file_category'};
my $mapping = {
'B' => { 'command' => 'BACK', 'color' => 'WHITE', 'access_level' => 'USER', 'text' => 'Return to File Menu' },
'Y' => { 'command' => 'YMODEM', 'color' => 'YELLOW', 'access_level' => 'VETERAN', 'text' => 'Upload with the Ymodem protocol' },
'X' => { 'command' => 'XMODEM', 'color' => 'BRIGHT BLUE', 'access_level' => 'VETERAN', 'text' => 'Upload with the Xmodem protocol' },
'Z' => { 'command' => 'ZMODEM', 'color' => 'GREEN', 'access_level' => 'VETERAN', 'text' => 'Upload with the Zmodem protocol' },
};
$self->show_choices($mapping);
$self->prompt('Choose');
do {
$ckey = uc($self->get_key());
} until ($ckey =~ /B|X|Y|Z/);
$self->output($mapping->{$ckey}->{'command'});
if ($mapping->{$ckey}->{'command'} eq 'XMODEM') {
if ($self->files_receive_file($file, XMODEM)) {
my $filename = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file;
my $size = (-s $filename);
my $sth = $self->{'dbh'}->prepare('INSERT INTO files (category,filename,title,file_type,description,file_size) VALUES (?,?,?,(SELECT id FROM file_types WHERE extension=?),?,?');
$sth->execute($file_category, $file, $title, $ext, $description, $size);
$sth->finish();
} ## end if ($self->files_receive_file...)
} elsif ($mapping->{$ckey}->{'command'} eq 'YMODEM') {
if ($self->files_receive_file($file, YMODEM)) {
my $filename = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file;
my $size = (-s $filename);
my $sth = $self->{'dbh'}->prepare('INSERT INTO files (category,filename,title,file_type,description,file_size) VALUES (?,?,?,(SELECT id FROM file_types WHERE extension=?),?,?');
$sth->execute($file_category, $file, $title, $ext, $description, $size);
$sth->finish();
} ## end if ($self->files_receive_file...)
} elsif ($mapping->{$ckey}->{'command'} eq 'ZMODEM') {
if ($self->files_receive_file($file, ZMODEM)) {
my $filename = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file;
my $size = (-s $filename);
my $sth = $self->{'dbh'}->prepare('INSERT INTO files (category,filename,title,file_type,description,file_size) VALUES (?,?,?,(SELECT id FROM file_types WHERE extension=?),?,?');
$sth->execute($file_category, $file, $title, $ext, $description, $size);
$sth->finish();
} ## end if ($self->files_receive_file...)
} else {
return (FALSE);
}
if ($? == -1) {
$self->{'debug'}->ERROR(["Could not execute rz: $!"]);
} elsif ($? & 127) {
$self->{'debug'}->ERROR(["File Transfer Aborted: $!"]);
} else {
$self->{'debug'}->DEBUG(['File Transfer Successful']);
}
return (TRUE);
} ## end sub files_upload_choices
sub files_list_detailed {
my ($self, $search) = @_;
$self->{'debug'}->DEBUG(['Start Files List Detailed']);
my $sth;
my $filter;
my $columns = $self->{'USER'}->{'max_columns'};
if ($search) {
$self->prompt('Search for');
$filter = $self->get_line({ 'type' => STRING, 'max' => 255, 'default' => '' });
$sth = $self->{'dbh'}->prepare('SELECT * FROM files_view WHERE (filename LIKE ? OR title LIKE ?) AND category_id=? ORDER BY uploaded DESC');
$sth->execute('%' . $filter . '%', '%' . $filter . '%', $self->{'USER'}->{'file_category'});
} else {
$sth = $self->{'dbh'}->prepare('SELECT * FROM files_view WHERE category_id=? ORDER BY uploaded DESC');
$sth->execute($self->{'USER'}->{'file_category'});
}
my @files;
if ($sth->rows > 0) {
$self->{'debug'}->DEBUGMAX(\@files);
my $table;
my $mode = $self->{'USER'}->{'text_mode'};
while (my $row = $sth->fetchrow_hashref()) {
push(@files, $row);
}
$sth->finish();
foreach my $record (@files) {
if ($mode eq 'ANSI') {
$self->output("\n" . '[% HORIZONTAL RULE GREEN %]' . "\n");
$self->output('[% B_BLUE %][% BRIGHT WHITE %] TITLE [% RESET %] ' . $record->{'title'} . "\n");
$self->output('[% B_BLUE %][% BRIGHT WHITE %] FILENAME [% RESET %] ' . $record->{'filename'} . "\n");
$self->output('[% B_BLUE %][% BRIGHT WHITE %] FILE SIZE [% RESET %] ' . format_number($record->{'file_size'}) . "\n");
if ($record->{'prefer_nickname'}) {
$self->output('[% B_BLUE %][% BRIGHT WHITE %] UPLOADER [% RESET %] ' . $record->{'nickname'} . "\n");
} else {
$self->output('[% B_BLUE %][% BRIGHT WHITE %] UPLOADER [% RESET %] ' . $record->{'fullname'} . "\n");
}
$self->output('[% B_BLUE %][% BRIGHT WHITE %] FILE TYPE [% RESET %] ' . $record->{'type'} . "\n");
$self->output('[% B_BLUE %][% BRIGHT WHITE %] UPLOADED [% RESET %] ' . $record->{'uploaded'} . "\n");
$self->output('[% B_BLUE %][% BRIGHT WHITE %] THUMBS [% RESET %] [% THUMBS UP SIGN %] ' . (0 + $record->{'thumbs_up'}) . ' [% THUMBS DOWN SIGN %] ' . (0 + $record->{'tumbs_down'}) . "\n");
$self->output('[% HORIZONTAL RULE GREEN %]' . "\n");
} else {
$self->output("\n TITLE: " . $record->{'title'} . "\n");
$self->output(' FILENAME: ' . $record->{'filename'} . "\n");
$self->output(' FILE SIZE: ' . format_number($record->{'file_size'}) . "\n");
if ($record->{'prefer_nickname'}) {
$self->output(' UPLOADER: ' . $record->{'nickname'} . "\n");
} else {
$self->output(' UPLOADER: ' . $record->{'fullname'} . "\n");
}
$self->output(' FILE TYPE: ' . $record->{'type'} . "\n");
$self->output(' UPLOADED: ' . $record->{'uploaded'} . "\n");
$self->output(' THUMBS UP: ' . (0 + $record->{'thumbs_up'}) . "\n");
$self->output('THUMBS DOWN: ' . (0 + $record->{'thumbs_down'}) . "\n");
} ## end else [ if ($mode eq 'ANSI') ]
last unless ($self->files_choices($record));
} ## end foreach my $record (@files)
} elsif ($search) {
$self->output("\nSorry '$filter' not found");
} else {
$self->output("\nSorry, this file category is empty\n");
}
$self->output("\nPress a key to continue ...");
$self->get_key(ECHO, BLOCKING);
$self->{'debug'}->DEBUG(['End Files List Detailed']);
return (TRUE);
} ## end sub files_list_detailed
sub files_save_file {
my ($self) = @_;
$self->{'debug'}->DEBUG(['Start Save File']);
$self->{'debug'}->DEBUG(['End Save File']);
return (TRUE);
} ## end sub files_save_file
sub files_receive_file {
my ($self, $file, $protocol) = @_;
my $success = TRUE;
$self->{'debug'}->DEBUG(['Start Receive File']);
unless ($self->{'local_mode'}) {
if ($protocol == YMODEM) {
$self->{'debug'}->DEBUG(["Send file $file with Ymodem"]);
$success = $self->files_receive_file_ymodem($self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file);
} elsif ($protocol == ZMODEM) {
$self->{'debug'}->DEBUG(["Send file $file with Zmodem"]);
$success = $self->files_receive_file_zmodem($self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file);
} else { # Xmodem
$success = $self->files_receive_file_xmodem($self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'} . '/' . $file);
$self->{'debug'}->DEBUG(["Send file $file with Xmodem"]);
}
} else {
$self->output("Upload not allowed in local mode\n");
}
$self->{'debug'}->DEBUG(['End Receive File']);
return ($success);
} ## end sub files_receive_file
sub files_receive_file_xmodem {
my ($self, $file) = @_;
$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;
lib/BBS/Universal/FileTransfer.pm view on Meta::CPAN
# if exec fails
POSIX::_exit(1);
} ## end if ($pid == 0)
# parent: wait for child, return success based on exit status
waitpid($pid, 0);
my $status = $?; # full status
if ($status == -1) {
$self->{'debug'}->ERROR(["Failed to waitpid for $cmd: $!"]);
return 0;
}
my $exitcode = ($status >> 8) & 0xFF;
if ($exitcode != 0) {
$self->{'debug'}->DEBUG(["$cmd exited with code $exitcode"]);
}
return $exitcode == 0 ? 1 : 0;
} ## end sub _run_on_socket
sub files_send_zmodem {
my ($self, $file) = @_;
$self->{'debug'}->DEBUG(['Start files_send_zmodem (using lrzsz)']);
# Require lrzsz (sz) to be installed on the system.
# sz will write to the socket (which we've dup'd to STDOUT in child).
my $sock = $self->{'cl_socket'};
unless ($sock) {
$self->{'debug'}->ERROR(["No client socket for ZMODEM send"]);
return 0;
}
$self->output("\nStart Zmodem file download\n");
# full path to file on server
my $path = $file;
unless (-e $path) {
$self->{'debug'}->ERROR(["File not found for ZMODEM send: $path"]);
return 0;
}
# Use sz --zmodem --binary --quiet --resume <file>
# note: --resume is helpful if client requests resume. Adjust flags per your lrzsz version.
my @args = ('--zmodem', '--binary', '--quiet', '--resume', $path);
my $ok = $self->_run_on_socket('sz', \@args);
$self->output("\nFile download complete\n");
$self->{'debug'}->DEBUG(['End files_send_zmodem (using lrzsz)']);
return $ok;
} ## end sub files_send_zmodem
sub files_receive_file_zmodem {
my ($self, $file) = @_;
$self->{'debug'}->DEBUG(['Start files_receive_file_zmodem (using lrzsz)']);
my $sock = $self->{'cl_socket'};
unless ($sock) {
$self->{'debug'}->ERROR(["No client socket for ZMODEM receive"]);
return 0;
}
$self->output("\nStart Zmodem file upload\n");
# When rz receives files it writes them into the current working directory.
# Use the destination directory from config (same place other uploads are stored).
my $dest_dir = $self->{'CONF'}->{'BBS ROOT'} . '/' . $self->{'CONF'}->{'FILES PATH'} . '/' . $self->{'USER'}->{'file_category_path'};
# ensure directory exists
unless (-d $dest_dir) {
File::Path::mkpath($dest_dir);
if ($@) {
$self->{'debug'}->ERROR(["Failed to create dest dir $dest_dir: $@"]);
return 0;
}
} ## end unless (-d $dest_dir)
# We will chdir in the child before exec so the received file lands in $dest_dir.
# Use rz --binary --quiet. Depending on lrzsz version you may want --overwrite or --keep
my @args = ('--binary', '--overwrite', '--quiet');
my $ok = $self->_run_on_socket('rz', \@args, $dest_dir);
$self->output("\nFile upload complete\n");
$self->{'debug'}->DEBUG(['End files_receive_file_zmodem (using lrzsz)']);
return $ok;
} ## end sub files_receive_file_zmodem
1;
( run in 1.055 second using v1.01-cache-2.11-cpan-b16cb0d3907 )