#!/usr/local/bin/perl ## Copyright(c) 1998-1999 by John C. Siracusa. All rights reserved. This ## program is free software; you can redistribute it and/or modify it under ## the same terms as Perl itself. ## ## hlftp.pl - A simple FTP-like hotline client by John Siracusa, created to ## demonstrate the Net::Hotline::Client module's blocking task mode. ## ## Created: July 10th, 1998 ## Modified: September 21st, 1999 ## use strict; use Cwd; use Text::Wrap; use Getopt::Std; use Term::ReadLine; use Time::localtime; use Net::Hotline::Client; use Net::Hotline::Constants qw(HTXF_PARTIAL_TYPE HTXF_PARTIAL_CREATOR HTLC_MACOS_TO_UNIX_TIME HTLC_FOLDER_TYPE HTLC_INFO_FOLDER_TYPE HTLC_INFO_FALIAS_TYPE); my $VERSION = '1.07'; my(%OPT, $LPWD, $RPWD, $NICK, $TERM); getopts('bchn:pquvx', \%OPT); if($OPT{'v'}) { print "hlftp version $VERSION by John Siracusa\n"; exit(0); } Usage() if($OPT{'h'}); my $DEF_LOGIN = 'guest'; my $DEF_PASSWORD = ''; my $DEF_SERVER = undef; my $DEF_PORT = undef; my $DEF_ICON = 410; my $ICON = $DEF_ICON; my $LOGIN = $DEF_LOGIN; my $MACOS = ($^O eq 'MacOS'); my $LOCAL_SEP = ($MACOS) ? ':' : '/'; my $REMOTE_SEP = ':'; my $MACBIN_MODE = ($OPT{'b'} || !$MACOS) ? 1 : 0; my $CLOBBER_MODE = ($OPT{'c'}) ? 1 : 0; my $PROMPTING = 1; my $COLS = $ENV{'COLUMNS'} || $ENV{'COLS'} || 80; $Text::Wrap::columns = $COLS; my $OUT = *STDOUT; $Net::Hotline::Client::DEBUG = 0; my $FOLDER_REGEX = join ('|', HTLC_FOLDER_TYPE, HTLC_INFO_FOLDER_TYPE, HTLC_INFO_FALIAS_TYPE); my %HELP = ( 'cd' => 'cd Change remote working directory to ', 'clobber' => 'clobber Toggle overwrite-when-downloading behavior.', 'close' => 'close Disconnect from the server.', 'del' => 'del Delete from the server.', 'dir' => 'dir Does an "ls -l" on in the server.', 'get' => 'get Get from the remote server.', 'help' => 'help Get general help or help for ', 'icon' => 'icon Set your icon to ', 'info' => 'info Get information about ', 'lcd' => 'lcd Change local working directory to ', 'ldir' => 'ldir Does an "ls -l" on the local directory ', 'lls' => 'lls [-l] List files in the local directory ', 'lpwd' => 'lpwd Show the current local working directory.', 'ls' => 'ls [-l] List files in on the server.', 'macbin' => 'macbin Toggle MacBinary download mode.', 'mget' => 'mget Get files matching from the server.', 'mput' => 'mput Put files matching on server.', 'nick' => 'nick Set your nickname to ', 'open' => 'open Open connection to ', 'prompt' => 'prompt Toggle cautionary prompting.', 'pwd' => 'pwd Show the current remote working directory.', 'quiet' => 'quiet Quiet mode: less verbose output.', 'quit' => 'quit Exit hlftp.', 'status' => 'status Show current status.', 'version' => 'version Show the hlftp version number.', 'wd' => 'wd Show local and remote working directories.'); sub print_wrap; # Forward declaration MAIN: { my($login, $pass, $server, $port, $path) = Parse_Command_Line(); my($hlc) = Start_Up($login, $pass, $server, $port, $path); Converse($hlc, $server); } sub Parse_Command_Line { if(@ARGV == 0) { return($DEF_LOGIN, $DEF_PASSWORD, $DEF_SERVER, $DEF_PORT, undef); } elsif(@ARGV > 1) { Usage(); } else { $_ = $ARGV[0]; s#^ho?t?li?n?e?://##i; if(m{^([^:]+):([^@]+)@([^:/]*) # Login, pass, server (?::(\d+))? # Port (/.*)?$ # Path }ix) { return($1, $2, $3, $4, $5); } elsif(m{^([^:@]+):?@([^:/]*) # Login, server (?::(\d+))? # Port (/.*)?$ # Path }ix) { return($1, $DEF_PASSWORD, $2, $3, $4); } elsif(m{^([^:/]*)(?::(\d+))? # Server, port (/.*)?$ # Path }ix) { return($DEF_LOGIN, $DEF_PASSWORD, $1, $2, $3); } else { Usage(); } } } sub Usage { print STDERR<<'EOF'; Usage: hlftp [-bchpquvx] [-n nick] [hotline://user:pass@host.com:port/path/] -b MacBinary mode (on by default on non-Mac OS systems). -c Clobber mode: overwrite existing files. -h Show this help screen. -p Use shorter prompt. -q Quiet mode: less verbose output. -u Prompt for username and password. -v Show the hlftp version number. -x Exit after failed command line connections. EOF exit(1); } sub Help { my($cmd) = shift; my($printed); if($cmd =~ /\S/) { $cmd = Shell_RE_To_Perl_RE($cmd); if(Safe_Regex(\$cmd)) { foreach my $hcmd (sort(keys(%HELP))) { if($hcmd =~ /^$cmd$/i) { print $OUT "\n" unless($printed); print_wrap $HELP{$hcmd}, "\n"; $printed = 1; } } if($printed) { print $OUT "\n" } else { print_wrap "No commands matching \"$cmd\" were found.\n"; } } else { print_wrap "Bad regex: $cmd\n"; } } else { my(@cmds, $i, $j, $cols); @cmds = sort(keys(%HELP)); $cols = int($COLS/10); print_wrap "'help ' gives a brief description of \n\n"; for($i = 0; $i <= $#cmds;) { for($j = 0; $j < $cols && $i <= $#cmds; $j++) { print $OUT sprintf("%-10s", $cmds[$i]); $i++; } print $OUT "\n"; } print $OUT "\n"; } } sub Start_Up { my($login, $pass, $server, $port, $path) = @_; my($server_arg) = $server; if($MACBIN_MODE && $MACOS) { print_wrap "Sorry, MacBinary mode is disabled on Mac OS.\n"; MacBinary_Mode('off'); } ($login, $pass) = Login_Pass() if($OPT{'u'}); my($hlc) = new Net::Hotline::Client; $LPWD = cwd(); $hlc->downloads_dir($LPWD); $hlc->blocking_tasks(1); return($hlc) unless($server); $path = Convert_Path($path); $server_arg .= ":$port" if($port =~ /^\d+$/); print_wrap "Connecting to $server_arg...\n" unless($OPT{'q'}); unless($hlc->connect($server_arg)) { print_wrap $hlc->last_error(), "\n"; exit(1) if($OPT{'x'}); return($hlc); } unless(length($NICK)) { if($OPT{'n'}) { $NICK = $OPT{'n'} } else { $NICK = $login } } print_wrap "Logging in as \"$login\"...\n" unless($OPT{'q'}); unless($hlc->login(Login => $login, Password => $pass, Nickname => $NICK, Icon => $DEF_ICON, News => 'no', UserList => 'no')) { print_wrap "Login to $server_arg failed: ", $hlc->last_error(), "\n"; exit(1) if($OPT{'x'}); return($hlc); } $LOGIN = $login; unless(length($NICK)) { if($OPT{'n'}) { $NICK = $OPT{'n'} } else { $NICK = $login } } if($path =~ m#:|/#) { print_wrap "Changing directory to ...\n" unless($OPT{'q'}); Change_Dir_Remote($hlc, $path); } elsif(length($path)) { # Check that path is a directory my($info) = $hlc->get_fileinfo($path); unless($info) { print_wrap "No such file or directory: $path\n"; if($OPT{'x'}) { $hlc->disconnect(); exit(1); } return($hlc); } if($info->type() =~ /^($FOLDER_REGEX)$/i) { print_wrap "Changing directory to $path...\n" unless($OPT{'q'}); Change_Dir_Remote($hlc, $path); } else { if(Get_File($hlc, $path)) { $hlc->disconnect(); exit; } } } else { $RPWD = ''; } return($hlc); } sub Disconnect { my($hlc, $prompt_ref) = @_; if($hlc->connected()) { $hlc->disconnect(); print_wrap "Connection closed.\n" unless($OPT{'q'}); Set_Prompt($hlc, $prompt_ref); } else { print_wrap "Not connected.\n" unless($OPT{'q'}); } } sub Reconnect { my($hlc, $user_pass, $server) = @_; my($login, $pass); if($hlc->connected()) { print_wrap "Closing connection to ", $hlc->server(), "...\n"; $hlc->disconnect(); } if($user_pass) { ($login, $pass) = Login_Pass(); } else { ($login, $pass) = ($DEF_LOGIN, $DEF_PASSWORD); } unless(length($NICK)) { if($OPT{'n'}) { $NICK = $OPT{'n'} } else { $NICK = $login } } $LOGIN = $login; $RPWD = ''; print_wrap "Connecting to $server...\n" unless($OPT{'q'}); unless($hlc->connect($server)) { print_wrap "Connection failed.\n"; return; } print_wrap "Logging in as \"$login\"...\n" unless($OPT{'q'}); unless($hlc->login(Login => $login, Password => $pass, Nickname => $NICK, Icon => $ICON, NoNews => 1, NoUserList => 1)) { print_wrap "Login to $server failed: ", $hlc->last_error(), "\n"; return; } return(1); } sub Login_Pass { my($login, $pass, $def); if($NICK) { $def = $NICK } elsif($OPT{'n'}) { $def = $OPT{'n'} } else { $def = $DEF_LOGIN } print_wrap "Login ($def): "; chomp($login = ); system 'stty', '-echo' unless($MACOS); print_wrap 'Password: '; chomp($pass = ); unless($MACOS) { system 'stty', 'echo'; print $OUT "\n"; } $login = $def unless(length($login)); $pass = $DEF_PASSWORD unless(length($pass)); return($login, $pass); } sub Converse { my($hlc, $server) = @_; my($cmd, $prompt); $TERM = new Term::ReadLine 'Hotline FTP'; $OUT = $TERM->OUT || *STDOUT; print $OUT "Welcome to hlftp version $VERSION by John Siracusa\n" unless($OPT{'q'} || @ARGV); Set_Prompt($hlc, \$prompt); while(defined($cmd = $TERM->readline($prompt))) { Process_Command($hlc, $cmd, \$prompt); $TERM->addhistory($cmd) if($cmd =~ /\S/); } } sub Process_Command { my($hlc, $cmd, $prompt_ref) = @_; return unless($cmd =~ /\S/); for($cmd) { s/^\s*//; s/\s*$//; } return unless(length($cmd)); $_ = $cmd; if(/^ls(?:\s+(?:(-l)(?:\s+|$))?(.*))?/) { List($hlc, $1, $2); } elsif(/^lls(?:\s+(?:(-l)(?:\s+|$))?(.*))?/) { List_Local($hlc, $1, $2); } elsif(/^(?:dir|ll)(?:\s+(\S.*))?$/) { List($hlc, '-l', $1); } elsif(/^(?:lll|ldir)(?:\s+(\S.*))?$/) { List_Local($hlc, '-l', $1); } elsif(/^cd\s+(\S.*)/) { Change_Dir_Remote($hlc, $1); } elsif(/^\.\.$/) { Change_Dir_Remote($hlc, '..'); } elsif(/^lcd\s+(\S.*)/) { Change_Dir_Local($hlc, $1); } elsif(/^get\s+(\S.*)/) { Get_File($hlc, $1); } elsif(/^mget\s+(\S.*)/) { Get_Files($hlc, $1); } elsif(/^put\s+(\S.*)/) { Put_File($hlc, $1); } elsif(/^mput\s+(\S.*)/) { Put_Files($hlc, $1); } elsif(/^(?:del(?:ete)?|rm)\s+(\S.*)/) { Delete_File($hlc, $1); } elsif(/^mkdir\s+(\S.*)/) { Make_Dir($hlc, $1); } elsif(/^clobber(?:\s+(on|yes|off|no))?$/) { Clobber_Mode($hlc, $1); } elsif(/^(?:mac)?bin(?:ary)?(?:\s+(on|yes|off|no))?$/) { MacBinary_Mode($1); } elsif(/^info(?:rmation)?\s+(\S.*)/) { Get_Info($hlc, $1); } elsif(/^(?:\?+|help)(?:\s+(\S.*))?$/i) { Help($1); } elsif(/^close$/) { Disconnect($hlc, $prompt_ref); } elsif(/^open\s+(?:(-u)\s+)?(\S.*)/) { Reconnect($hlc, $1, $2); Set_Prompt($hlc, $prompt_ref); } elsif(/^prompt$/) { $PROMPTING = ($PROMPTING) ? 0 : 1; print $OUT "Interactive mode ", ($PROMPTING) ? 'on' : 'off', ".\n"; } elsif(/^long\s*prompt$/) { $OPT{'p'} = 0; Set_Prompt($hlc, $prompt_ref); } elsif(/^short\s*prompt$/) { $OPT{'p'} = 1; Set_Prompt($hlc, $prompt_ref); } elsif(/^ver(s(ion)?)?$/) { print $OUT "hlftp version $VERSION by John Siracusa\n"; } elsif(/^[cp]wd$/) { print_wrap "Remote dir: ", (length($RPWD)) ? $RPWD : '', "\n"; } elsif(/^l[cp]?wd$/) { print_wrap "Local dir: $LPWD\n"; } elsif(/^wd$/) { print_wrap "Local dir: $LPWD\n", "Remote dir: ", (length($RPWD)) ? $RPWD : '', "\n"; } elsif(/^(?:q(?:uit)?|bye|exit|x)$/) { $hlc->disconnect(); exit; } elsif(/^nick\s+("?)(\S.*?)\1$/) #" { if(Nick($hlc, $2)) { Set_Prompt($hlc, $prompt_ref); } } elsif(/^icon\s+(\d+)/) { Icon($hlc, $1); Set_Prompt($hlc, $prompt_ref); } elsif(/^stat(s|us)?/) { Status($hlc); } elsif(/^quiet|shh+$/) { $OPT{'q'} = !$OPT{'q'}; print_wrap "Quiet mode OFF.\n" unless($OPT{'q'}); } else { print_wrap "Invalid command: $cmd\n"; } } sub Status { my($hlc) = shift; if($hlc->connected()) { print_wrap "Nick: $NICK\n", "Login: $LOGIN\n", "Icon: $ICON\n", "Server: ", $hlc->server(), "\n", "Local: $LPWD\n", "Remote: ", (length($RPWD)) ? $RPWD : '', "\n", } else { print_wrap "Nick: $NICK\n", "Login: $LOGIN\n", "Icon: $ICON\n", "Server: (Not connected)\n", "Local: $LPWD\n", "Remote: (Not connected)\n"; } } sub MacBinary_Mode { my($onoff) = shift; if($MACOS) { print_wrap "Sorry, MacBinary mode is disabled on Mac OS.\n"; return; } if(defined($onoff)) { if($onoff =~ /^(on|yes)$/i) { $MACBIN_MODE = 1; print_wrap "MacBinary mode ON.\n"; } else { $MACBIN_MODE = 0; print_wrap "MacBinary mode OFF.\n"; } } else { $MACBIN_MODE = !$MACBIN_MODE; print_wrap "MacBinary mode ", ($MACBIN_MODE) ? 'ON' : 'OFF', "\n"; } } sub Clobber_Mode { my($hlc, $onoff) = @_; if(defined($onoff)) { if($onoff =~ /^(on|yes)$/i) { $CLOBBER_MODE = 1; print_wrap "Clobber mode ON.\n"; } else { $CLOBBER_MODE = 0; print_wrap "Clobber mode OFF.\n"; } } else { $CLOBBER_MODE = !$CLOBBER_MODE; print_wrap "Clobber mode ", ($CLOBBER_MODE) ? 'ON' : 'OFF', "\n"; } } sub Get_File { my($hlc, $path, $absolute) = @_; unless($hlc->connected()) { print_wrap "Not connected.\n"; return; } my($file, $task, $ref, $size, $data_file, $rsrc_file, $finished_file, $resume, $ret, $clobber, @path); if($absolute) { @path = split($REMOTE_SEP, $path); } else { @path = Rel_To_Abs_Path_Remote(Convert_Path(Clean_Path($path))) } $path = join($REMOTE_SEP, @path); $file = $path[$#path]; if(length($path)) { # Check that path exists and is a file my($info) = $hlc->get_fileinfo($path); unless($info && $info->type() !~ /^($FOLDER_REGEX)$/) { print_wrap "No such file: $path\n"; return; } } else { print_wrap "No such file: $path\n"; return; } $finished_file = Rel_To_Abs_Path_Local($file); $data_file = $finished_file . $hlc->data_fork_extension(); $rsrc_file = $finished_file . $hlc->rsrc_fork_extension(); if(-e $finished_file) { $clobber = 1; if($MACOS) { my($creator, $type) = MacPerl::GetFileInfo($finished_file); if($type eq Net::Hotline::Constants::HTXF_PARTIAL_TYPE && $creator eq Net::Hotline::Constants::HTXF_PARTIAL_CREATOR) { $resume = 1; $clobber = 0; } } } if($clobber) { if($CLOBBER_MODE) { unless(unlink($finished_file)) { print_wrap "Could not delete $file: $!\n"; return; } } else { print_wrap "\"$file\" already exists. Set \"clobber\" to overwrite.\n"; return; } } if(!$MACOS) { $resume = (-e $rsrc_file || -e $data_file); } if(-e "$finished_file.bin" && $MACBIN_MODE) { if($CLOBBER_MODE) { unless(unlink("$finished_file.bin")) { print_wrap "Could not delete $file.bin: $!\n"; return; } } else { print_wrap "\"$file.bin\" already exists. Set \"clobber\" to overwrite.\n"; return; } } if($resume) { ($task, $ref, $size) = $hlc->get_file_resume($path); } else { ($task, $ref, $size) = $hlc->get_file($path); } unless($task) { print_wrap $hlc->last_error(), "\n"; return; } if($resume) { print_wrap "Resuming file download: \"$file\" ($size bytes)...\n" unless($OPT{'q'}); } else { print_wrap "Getting file \"$file\" ($size bytes)...\n" unless($OPT{'q'}); } $ret = $hlc->recv_file($task, $ref, $size); unless($ret) { print_wrap "Download failed: ", $hlc->last_error(), "\n"; return; } if($MACBIN_MODE && ref($ret)) { print_wrap "Creating MacBinary file \"$file.bin\"...\n" unless($OPT{'q'}); unless($hlc->macbinary(undef, $ret)) { print_wrap "Could not create MacBinary file: ", $hlc->last_error(), "\n"; return; } # Delete the separate data and resource fork files unlink($data_file) if(-e $data_file); unlink($rsrc_file) if(-e $rsrc_file); } return(1); } sub Put_File { my($hlc, $path) = @_; unless($hlc->connected()) { print_wrap "Not connected.\n"; return; } my($file, $task, $ref, $size, $remote_path, $check_file, $files, $resume, $replace, $rflt, @path); @path = Rel_To_Abs_Path_Local($path); $file = $path[$#path]; $remote_path = "$RPWD:$file"; unless(-e $path) { print_wrap "File not found: $path\n"; return; } if(-d $path) { print_wrap "Cannot put a directory. Use \"mput\" instead.\n"; return; } $files = $hlc->get_filelist($RPWD); unless($files) { print_wrap "Could not get file list for folder $RPWD: ", $hlc->last_error(), "\n"; return; } foreach my $check_file (@{$files}) { next unless($check_file->name() eq $file); if($check_file->type() eq HTXF_PARTIAL_TYPE && $check_file->creator() eq HTXF_PARTIAL_CREATOR) { $resume = 1; } else { $replace = 1; } } if($replace) { print_wrap "A file named \"$file\" already exists.\n"; return; } if($resume) { ($task, $ref, $size, $rflt) = $hlc->put_file_resume($path, $RPWD); } else { ($task, $ref, $size) = $hlc->put_file($path, $RPWD); } unless($task) { print_wrap $hlc->last_error(), "\n"; return; } if($resume) { print_wrap "Resuming upload of file \"$file\" ($size bytes)...\n" unless($OPT{'q'}); } else { print_wrap "Putting file \"$file\" ($size bytes)...\n" unless($OPT{'q'}); } unless($hlc->send_file($task, $ref, $size, $rflt)) { print_wrap "Upload failed: ", $hlc->last_error(), "\n"; return; } return(1); } sub Put_Files { my($hlc, $path) = @_; unless($hlc->connected()) { print_wrap "Not connected.\n"; return; } my(@path, $save_path, $dir, $check_path, $file, $regex, $found, $cd_backone, $res); $save_path = $path; @path = Rel_To_Abs_Path_Local($path); $check_path = Rel_To_Abs_Path_Local($path); if(-d $check_path) { print_wrap "Put the entire directory \"$save_path\"? (y/n) [n]: "; chomp($res = ); unless($res =~ /^\s*y(es|up|eah)?\s*$/i) { print_wrap "mput aborted.\n"; return(0); } $dir = $check_path; $regex = '*'; unless(Make_Dir($hlc, $path[$#path])) { print_wrap "mput aborted.\n"; return(0); } unless(Change_Dir_Remote($hlc, $path[$#path])) { print_wrap "mput aborted.\n"; return(0); } $cd_backone = 1; } else { $dir = (($MACOS) ? '' : $LOCAL_SEP) . join($LOCAL_SEP, @path[0 .. $#path - 1]); $regex = $path[$#path]; } $regex = Shell_RE_To_Perl_RE($regex); unless(Safe_Regex(\$regex)) { $regex = quotemeta($regex); } unless(opendir(DIR, $dir)) { print_wrap "Could not read directory \"$dir\" - $!\n"; return(0); } while($file = readdir(DIR)) { next if($file !~ /^$regex$/); if(-d "$dir$LOCAL_SEP$file") { print_wrap "Skipping directory \"$dir$LOCAL_SEP$file\"\n" unless($OPT{'q'} || ($file =~ /^\.\.?$/ && !$MACOS)); next; } $found = 1; if($PROMPTING) { print_wrap "Put \"$file\"? (ynq) [n]: "; chomp($res = ); if($res =~ /^\s*q(uit)?\s*$/i) { print_wrap "mput aborted.\n"; return(0); } elsif($res !~ /^\s*y(es|up|eah)?\s*/i) { next; } } unless(Put_File($hlc, "$dir$LOCAL_SEP$file")) { if($PROMPTING) { my($res); print_wrap "Continue with mput? (y/n) [n]: "; chomp($res = ); return(1) unless($res =~ /^\s*y(es|up|eah)?\s*/i); } } } if($cd_backone) { Change_Dir_Remote($hlc, '..'); } unless($found) { print $OUT "mput: No match.\n"; } return(1); } sub Get_Files { my($hlc, $path) = @_; unless($hlc->connected()) { print_wrap "Not connected.\n"; return; } my(@path, $files, $name, $info, $regex, $save_path, $res, $file_path, $file_dir); $save_path = $path; @path = Rel_To_Abs_Path_Remote(Convert_Path(Clean_Path($path))); $path = join($REMOTE_SEP, @path); if(length($path)) { $info = $hlc->get_fileinfo($path); # Last part of the path could have been a regex unless(ref($info)) { $regex = pop(@path); $path = join($REMOTE_SEP, @path); if(length($path)) { $info = $hlc->get_fileinfo($path); unless(ref($info) && $info->type() =~ /^($FOLDER_REGEX)$/i) { print_wrap "No such file or directory: $save_path\n"; return; } } } elsif($info->type() =~ /^($FOLDER_REGEX)$/i) { print_wrap "Get the entire contents of the folder \"$path\"? (y/n) [n]: "; chomp($res = ); unless($res =~ /^\s*y(es|up|eah)?\s*$/i) { print_wrap "mget aborted.\n"; return(0); } } } if(defined($regex)) { $regex = Shell_RE_To_Perl_RE($regex); unless(Safe_Regex(\$regex)) { $regex = quotemeta($regex); } } $files = $hlc->get_filelist($path); $file_dir = $path; $path = '' unless(length($path)); unless($files) { print_wrap "Could not get file list for folder $path: ", $hlc->last_error(), "\n"; return; } foreach my $file (@{$files}) { $name = $file->name(); next if(defined($regex) && $name !~ /^$regex$/); if($PROMPTING) { print_wrap "Get \"$name\"? (ynq) [n]: "; chomp($res = ); if($res =~ /^\s*q(uit)?\s*$/i) { print_wrap "mget aborted.\n"; return(0); } elsif($res !~ /^\s*y(es|up|eah)?\s*/i) { next; } } $file_path = Rel_To_Abs_Path_Remote($name, $file_dir); unless(Get_File($hlc, $file_path, 'absolute')) { if($PROMPTING) { my($res); print_wrap "Continue with mget? (y/n) [n]: "; chomp($res = ); return(1) unless($res =~ /^\s*y(es|up|eah)?\s*/i); } } } return(1); } sub Nick { my($hlc, $nick) = @_; $nick =~ s/(^|^[^\\]|[^\\]{2})"/$1"/g; $nick =~ s/^(.{,31}).*/$1/; if(length($nick)) { $hlc->nick($nick) if($hlc->connected()); $NICK = $nick; return(1); } return; } sub Icon { my($hlc, $icon) = @_; $hlc->icon($icon) if($hlc->connected()); $ICON = $icon; } sub Get_Info { my($hlc, $path) = @_; unless($hlc->connected()) { print_wrap "Not connected.\n"; return; } my($name, @path, $info); @path = Rel_To_Abs_Path_Remote(Convert_Path(Clean_Path($path))); $path = join($REMOTE_SEP, @path); $name = $path[$#path]; $info = $hlc->get_fileinfo($path); unless(ref($info)) { print_wrap($hlc->last_error(), "\n"); return; } my($size, $units, $comments); ($size, $units) = Size_Units($info->size()); print_wrap "\n", "Name: ", $info->name(), "\n", "Size: $size $units\n", "Type: ", $info->type(), "\n", "Creator: ", $info->creator(), "\n", "Created: ", Date_Text($info->ctime()), "\n", "Modified: ", Date_Text($info->mtime()), "\n"; $comments = $info->comment(); if(length($comments)) { print_wrap "Comments: $comments\n"; } print $OUT "\n"; return(1); } sub Make_Dir { my($hlc, $path) = @_; unless($hlc->connected()) { print_wrap "Not connected.\n"; return; } my($name, @path); @path = Rel_To_Abs_Path_Remote(Convert_Path(Clean_Path($path))); $path = join($REMOTE_SEP, @path); $name = $path[$#path]; unless($hlc->new_folder($path)) { print_wrap($hlc->last_error(), "\n"); return; } print_wrap "Folder created: $name\n" unless($OPT{'q'}); return(1); } sub Delete_File { my($hlc, $path) = @_; unless($hlc->connected()) { print_wrap "Not connected.\n"; return; } my($folder, $name, @path, $res, $info, $regex, $save_path, $file_path, $file_dir, $found, $files); @path = Rel_To_Abs_Path_Remote(Convert_Path(Clean_Path($path))); $path = join($REMOTE_SEP, @path); $name = $path[$#path]; $save_path = $path; $info = $hlc->get_fileinfo($path); # Last part of the path could have been a regex unless(ref($info)) { $regex = pop(@path); $path = join($REMOTE_SEP, @path); if(length($path)) { $info = $hlc->get_fileinfo($path); unless(ref($info) && $info->type() =~ /^($FOLDER_REGEX)$/i) { print_wrap "No such file or directory: $save_path\n"; return; } } } else { if($info->type() =~ /^($FOLDER_REGEX)$/i && $PROMPTING) { $folder = 1; print_wrap "Really delete the folder \"$name\" and all its contents? (y/n) [n]: "; chomp($res = ); return(0) unless($res =~ /^\s*y(es|up|eah)?\s*$/i); } unless($hlc->delete_file($path)) { print_wrap $hlc->last_error(), "\n"; return; } print_wrap +($folder) ? "Folder" : "File", " deleted: $name\n" unless($OPT{'q'}); return(1); } if(defined($regex)) { $regex = Shell_RE_To_Perl_RE($regex); unless(Safe_Regex(\$regex)) { $regex = quotemeta($regex); } } $files = $hlc->get_filelist($path); $file_dir = $path; $path = '' unless(length($path)); unless($files) { print_wrap $hlc->last_error(), "\n"; return; } foreach my $file (@{$files}) { $name = $file->name(); next if(defined($regex) && $name !~ /^$regex$/); $found = 1; $folder = ($file->type() eq HTLC_FOLDER_TYPE); if($PROMPTING) { if($folder) { print_wrap "Really delete the folder \"$name\" and all its contents? (ynq) [n]: "; } else { print_wrap "Really delete \"$name\"? (ynq) [n]: "; } chomp($res = ); if($res =~ /^\s*q(uit)?\s*/i) { return(0); } elsif($res !~ /^\s*y(es|up|eah)?\s*$/i) { next; } } $file_path = Rel_To_Abs_Path_Remote($name, $file_dir); unless($hlc->delete_file($file_path)) { print_wrap $hlc->last_error(), "\n"; next; } print_wrap +($folder) ? "Folder" : "File", " deleted: $name\n" unless($OPT{'q'}); } if(!$found && !$OPT{'q'}) { print_wrap "del: No match.\n"; } return(1); } sub Rel_To_Abs_Path_Local { my($path, $start_dir) = @_; unless(length($path)) { return (split(/$LOCAL_SEP/, $LPWD)) if(wantarray); return $LPWD; } my($tmp, $dir, @dirs, @path, $ret); $start_dir = $LPWD unless(defined($start_dir)); if($path !~ /^$LOCAL_SEP/) { $tmp = "$start_dir$LOCAL_SEP$path"; } else { $tmp = $path; } $tmp =~ s/$LOCAL_SEP+/$LOCAL_SEP/g; @dirs = split(/$LOCAL_SEP/, $tmp); foreach my $dir (@dirs) { if($dir eq '..') { pop(@path) } elsif($dir eq '.') { next } elsif(length($dir)) { push(@path, $dir) } } # MacPerl's chdir() likes a trailing ':' if($MACOS) { $ret = join($LOCAL_SEP, @path) . $LOCAL_SEP; } # Other OSes have leading path separators on their absolute paths else { $ret = $LOCAL_SEP . join($LOCAL_SEP, @path); } return @path if(wantarray); return $ret; } sub Rel_To_Abs_Path_Remote { my($path, $start_dir) = @_; my($tmp, $dir, @dirs, @path); $start_dir = $RPWD unless(defined($start_dir)); if($path !~ /^$REMOTE_SEP/) { $tmp = "$start_dir$REMOTE_SEP$path"; } else { ($tmp = $path) =~ s/^$REMOTE_SEP//o; } $tmp =~ s/$REMOTE_SEP+/$REMOTE_SEP/g; @dirs = split(/$REMOTE_SEP/, $tmp); foreach my $dir (@dirs) { if($dir eq '..') { pop(@path) } elsif($dir eq '.') { next } elsif(length($dir)) { push(@path, $dir) } } return @path if(wantarray); return join($REMOTE_SEP, @path); } sub Change_Dir_Local { my($hlc, $path) = @_; $path = Rel_To_Abs_Path_Local($path); unless(chdir($path)) { print_wrap "Could not change directory to $path: $!\n"; return; } $LPWD = cwd(); $hlc->downloads_dir($LPWD); print_wrap "lcwd: $LPWD\n" unless($OPT{'q'}); } sub Change_Dir_Remote { my($hlc, $path) = @_; unless($hlc->connected()) { print_wrap "Not connected.\n"; return; } if($path =~ m#^(?:|/)$#) { $RPWD = ''; } else { my($abs) = ($path =~ m{^[:/]}); $path = Convert_Path(Clean_Path($path)); $path = Rel_To_Abs_Path_Remote($path) unless($abs); if(length($path)) { # Check that path exists and is a folder my($info) = $hlc->get_fileinfo($path); unless($info && $info->type() =~ /^(?:$FOLDER_REGEX)$/) { print_wrap "No such directory: $path\n"; return; } } $RPWD = $path; } unless($OPT{'q'} || $OPT{'p'}) { print_wrap "cwd: ", (length($RPWD)) ? $RPWD : '', "\n"; } } sub List { my($hlc, $long, $path) = @_; unless($hlc->connected()) { print $OUT "Not connected.\n"; return; } my(@path, $files, $info, $regex, $save_path); $save_path = $path; @path = Rel_To_Abs_Path_Remote(Convert_Path(Clean_Path($path))); $path = join($REMOTE_SEP, @path); if(length($path)) { $info = $hlc->get_fileinfo($path); # Last part of the path could have been a regex unless(ref($info)) { $regex = pop(@path); $path = join($REMOTE_SEP, @path); if(length($path)) { $info = $hlc->get_fileinfo($path); unless(ref($info) && $info->type() =~ /^($FOLDER_REGEX)$/i) { print_wrap "No such file or directory: $save_path\n"; return; } } } elsif($info->type() !~ /^($FOLDER_REGEX)$/i) { $regex = pop(@path); $path = join($REMOTE_SEP, @path); } } if(defined($regex)) { $regex = Shell_RE_To_Perl_RE($regex); unless(Safe_Regex(\$regex)) { $regex = quotemeta($regex); } } $files = $hlc->get_filelist($path); $path = '' unless(length($path)); unless($files) { print_wrap "Could not get file list for folder $path: ", $hlc->last_error(), "\n"; return; } unless(@{$files} > 0) { print_wrap "\n"; return; } if($long) { my($msg, $name, $size, $bytes, $type, $creator, $units); foreach my $file (@{$files}) { $name = $file->name(); next if(defined($regex) && $name !~ /^$regex$/); $size = $file->size(); $type = $file->type(); $creator = $file->creator(); $bytes = $size; $name .= ':' if($type eq HTLC_FOLDER_TYPE); if($type eq 'fldr') { $units = 'Items'; print $OUT sprintf("%-32s %10d %-5s Folder", $name, $size, $units); } else { if($size < 1024) { $units = 'bytes'; } elsif($size > 1024 && $size < (1024 * 1024)) { $units = 'KB'; $size = (int($size/1024)); } elsif($size > (1024 * 1024)) { $units = 'MB'; $size = $size/(1024 * 1024); } elsif($size > (1024 * 1024 *1024)) { $units = 'GB'; $size = $size/(1024 * 1024 *1024); } print $OUT sprintf("%-32s %10d %5.1f %-5s %4s %4s", $name, $bytes, $size, $units, $type, $creator); } print $OUT "\n"; } } else { my($max_length, $col_width, $cols, $name, @names, $i, $j); $max_length = 0; foreach my $file (@{$files}) { $name = $file->name(); next if(defined($regex) && $name !~ /^$regex$/); $name .= ':' if($file->type() eq HTLC_FOLDER_TYPE); push(@names, $name); $max_length = length($name) if(length($name) > $max_length); } $col_width = $max_length + 3; $col_width = 10 if($col_width < 10); $cols = int($COLS/$col_width); for($i = 0; $i <= $#names; $i += $cols) { for($j = 0; $j < $cols && defined($names[$i + $j]); $j++) { print $OUT $names[$i + $j], ' ' x ($col_width - length($names[$i + $j])); } print $OUT "\n"; } } } sub List_Local { my($hlc, $long, $path) = @_; my(@path, $files, $info, $regex, $save_path, $abs_path, $printed, $save_file, $save_abs_path); $save_path = $path; @path = Rel_To_Abs_Path_Local($path); $path = join($LOCAL_SEP, @path); $path .= $LOCAL_SEP if($MACOS); if(length($path)) { unless(-e $path) { $regex = pop(@path); $path = join($LOCAL_SEP, @path); $path .= $LOCAL_SEP if($MACOS); if(length($path)) { unless(-d $path) { print_wrap "No such file or directory: $save_path\n"; return; } } } } if(defined($regex)) { $regex = Shell_RE_To_Perl_RE($regex); unless(Safe_Regex(\$regex)) { $regex = quotemeta($regex); } } unless(opendir(DIR, $path)) { print_wrap "Could not read directory $path: $!\n"; return; } if($long) { my($file, $size, $is_dir, $bytes, $units, $type, $creator); foreach my $file (sort(readdir(DIR))) { $save_file = $file; $file =~ s/\015//g if($MACOS); next if(defined($regex) && $file !~ /^$regex$/); ($abs_path = "$path$LOCAL_SEP$file") =~ s/$LOCAL_SEP+/$LOCAL_SEP/og; ($save_abs_path = "$path$LOCAL_SEP$save_file") =~ s/$LOCAL_SEP+/$LOCAL_SEP/og; $bytes = $size = (stat($abs_path))[7]; $is_dir = (-d $abs_path) ? 1 : 0; if($is_dir) { $file .= $LOCAL_SEP; if($MACOS) { print $OUT sprintf("%-32s - Folder - -", $file); } else { print $OUT sprintf("%-40s %10d %-s", $file, $size, "(directory)"); } } else { ($size, $units) = Size_Units($size); if($MACOS) { ($type, $creator) = MacPerl::GetFileInfo($save_abs_path); print $OUT sprintf("%-32s %10d %5.1f %-5s %4s %4s", $file, $bytes, $size, $units, $type, $creator); } else { print $OUT sprintf("%-40s %10d %6.1f %-5s", $file, $bytes, $size, $units); } } print_wrap "\n"; $printed = 1; } } else { my($max_length, $col_width, $cols, $name, @names, $i, $j); foreach my $file (sort(readdir(DIR))) { $file =~ s/\015//g if($MACOS); next if(defined($regex) && $file !~ /^$regex$/); ($abs_path = "$path$LOCAL_SEP$file") =~ s/$LOCAL_SEP+/$LOCAL_SEP/og; $file .= $LOCAL_SEP if(-d $abs_path); push(@names, $file); $max_length = length($file) if(length($file) > $max_length); } $col_width = $max_length + 3; $col_width = 10 if($col_width < 10); $cols = int($COLS/$col_width); for($i = 0; $i <= $#names; $i += $cols) { for($j = 0; $j < $cols && defined($names[$i + $j]); $j++) { print $OUT $names[$i + $j], ' ' x ($col_width - length($names[$i + $j])); } print $OUT "\n"; } $printed = 1; } closedir(DIR); unless($printed) { if(defined($regex)) { print $OUT "No match.\n"; } else { print $OUT "\n"; } } } sub Set_Prompt { my($hlc, $prompt_ref) = @_; if(!$hlc->connected()) { $$prompt_ref = 'hlftp> '; } else { if($OPT{'p'}) { $$prompt_ref = '' } else { $$prompt_ref = "[$NICK:$ICON] " } $$prompt_ref .= $hlc->server() . '> '; } } sub Clean_Path { my($path) = shift; for($path) { s/^"(.*?)"$/$1/; s/^\\"/"/g; } $path; } sub Convert_Path { my($path) = shift; for($path) { s/\\\\/\\/g; s#(^|[^\\])/#$1:#g; s/^://; s/:$//; } $path; } sub Safe_Regex { my($re) = shift; while($$re =~ s/\(\?([^)]*)e([^)]*)\)/(?$1$2)/g){} eval { m/$$re/ }; if($@) { return undef } else { return 1 } } sub Shell_RE_To_Perl_RE { my($pre, $ignore_case) = @_; for($pre) { s/\\/\\\\/g; s/\./\\./g; s/\*/.*/g; s/\?/./g; } $pre .= '(?i)' if($ignore_case); return $pre; } sub Size_Units { my($size) = shift; return('n/a', undef) unless($size =~ /^\d+$/); my($units); if($size < 1024) { $units = 'bytes'; } elsif($size > 1024 && $size < (1024 * 1024)) { $units = 'KB'; $size = int($size/1024); } elsif($size > (1024 * 1024)) { $units = 'MB'; $size = $size/(1024 * 1024); } elsif($size > (1024 * 1024 *1024)) { $units = 'GB'; $size = $size/(1024 * 1024 *1024); } return($size, $units); } sub Date_Text { my($date) = shift; $date += HTLC_MACOS_TO_UNIX_TIME unless($MACOS); return ctime($date); } sub print_wrap { my($text) = join('', @_); print $OUT wrap("", "", $text); }