Network Programming with Perl

Chapter 6: FTP and Telnet

Important note: The version of the chapter presented here was converted from the pre-copyedited manuscript. This means that it may contain typographical errors, mistakes in grammar and spelling, and possibly even code errors that are not present in the published book.

Network Programming in Perl: Home Page



FTP and Telnet

Two of the oldest Internet protocols are the File Transfer Protocol, FTP, and Telnet, for remote login. They illustrate the two extremes of network protocols. On the one hand, an FTP session is a highly structured and predictable set of transactions. On the other hand, a Telnet session is unpredictable and highly interactive. However, Perl has modules that will tame them both.


Net::FTP

There's a directory on a remote FTP server which changes every few weeks. You want to mirror a copy of the directory on your local machine and update your copy every time it changes. You can't use one of the many ``mirror'' scripts to do this because the directory name contains a timestamp, and you'll need to do a pattern match in order to identify the right directory. Net::FTP to the rescue.

Net::FTP is part of the libnet utilities by Graham Barr. In addition to Net::FTP, Libnet includes Net::Telnet, Net::SMTP, and Net::POP3. We discuss Net::FTP and Net::Telnet in this chapter, and Net::SMTP and Net::POP3 in the next. When you install the libnet modules, the install script will prompt you for various default configuration parameters used by the Net::* modules. This includes such things as an FTP firewall proxy to use, and the default mail exchanger for your domain. See the documentation for Net::Config (also part of the libnet utilities) for information on how to override these defaults.

Net::FTP, like many of the client modules, uses an object-oriented interface. When you first log in to an FTP server, the module returns a Net::FTP object to you. You then use this object to get directory listings from the server, transfer files, and send other commands.

A Net::FTP Example

Figure 6.1 shows a simple example which uses Net::FTP to connect to ftp.perl.org and download the file named RECENT from the directory /pub/CPAN/.

Lines 1-5: Initialization
We load the Net::FTP module and define constants for the host to connect to and the file to download.

Line 6: Connect to remote host
We connect to the FTP host by invoking the Net::FTP new() method with the name of the host to connect to. If successful, new() returns a Net::FTP object connected to the remote server. Otherwise it returns undef, and we die with an error message. In case of failure, new() leaves a diagnostic error message in $@.

Lines 7: Log in to the server
After connecting to the server we still need to log in by calling the Net::FTP object's login() method with a username and password. In this case we are using anonymous FTP, so we provide the username ``anonymous'' and let Net::FTP fill in a reasonable default password. If login is successful, login() returns a true value. Otherwise it returns false and we die, using the FTP object's message() method to retrieve the text of the server's last message.

Line 8: Change to remote directory
We invoke the FTP object's cwd() method to enter the desired directory. If this call fails, we again die with the server's last message.

Line 9: Retrieve the file
We call the FTP object's get() method to retrieve the desired file. If successful, Net::FTP will copy the remote file to a local one of the same name in the current directory.

Lines 10-11: Quit
We call the FTP object's quit() method to close the connection politely.

If the program runs successfully, it will create a file named RECENT in the current directory. This file contains the names of all files recently uploaded to CPAN.

Figure 6.1: Downloading a single file with Net::FTP
 0    #!/usr/bin/perl -w
 1    # file: ftp_recent.pl
 2    use Net::FTP;
 3    use constant HOST => 'ftp.perl.org';
 4    use constant DIR  => '/pub/CPAN';
 5    use constant FILE => 'RECENT';
 6    my $ftp = Net::FTP->new(HOST) or die "Couldn't connect: $@\n";
 7    $ftp->login('anonymous')      or die $ftp->message;
 8    $ftp->cwd(DIR)                or die $ftp->message;
 9    $ftp->get(FILE)               or die $ftp->message;
 10   $ftp->quit;
 11   warn "File retrieved successfully.\n";

Net::FTP API

We'll now look in greater depth at the more common method calls in Net::FTP. See the module documentation for full information.

$ftp = Net::FTP->new($host [,%options])
The new() method creates a Net::FTP object. The mandatory first argument is the domain name of the FTP server you wish to contact. Additional optional arguments are a set of key/value pairs that set options for the session:
   Option               Description
   ------               -----------
   Firewall             Name of the FTP proxy to use when your machine
                        is behind certain types of firewalls.
   BlockSize            Block size of transfers (default 10240).
   Port                 FTP port to connect to (default 21).
   Timeout              Timeout value, in seconds, for various
                        operations (default 120 seconds).
   Debug                Debug level. Set to greater than zero for
                        verbose debug messages.
   Passive              Use FTP passive mode for all file
                        transfers. Required by some firewalls.
   Hash                 Prints a hash mark to STDERR for each
                        1024 bytes of data transferred.

For example, to connect to ``ftp.perl.org'' with hash marks enabled and a timeout of 30 seconds, we could use this statement:

 $ftp = Net::FTP('ftp.perl.org', Timeout=>30, Hash=>1);

$success = $ftp->login([$username [,$password [,$account]]])
The login() method attempts to log in to the server using the provided authentication information. If no username is provided, then Net::FTP assumes ``anonymous''. If no username or password is provided, then Net::FTP looks up the authentication information in the user's .netrc file. If this is still not found, it generates a password of the form ``$user@'', where $user is your login name.

The optional $account argument is for use with some FTP servers that require an additional authentication password to gain access to the filesystem after logging into the server itself.

Login() returns true if the login was successful, and false otherwise.

See the Net::Netrc manual pages for more information on the .netrc file.

$type = $ftp->ascii
Puts the FTP object into ASCII mode. The server will automatically perform newline translation during file transfers (ending lines with CRLF on Windows machines, LF on Unix machines and CR on Macintoshes). This is suitable for transferring text files.

The return value is the previous value of the transfer type, such as ``binary''.

Note: ASCII mode is the default.

$type = $ftp->binary
Puts the FTP object into BINARY mode. The server will not perform any translation. This is suitable for transferring binary files such as images.

$success = $ftp->rename($oldname,$newname)
Renames file $oldname to file $newname on the remote server, provided that you have sufficient privileges to do this.

$success = $ftp->delete($file)
Deletes the file $file on the server, provided that you have sufficient privileges to do this.

$success = $ftp->cwd([$directory])
Attempts to change the current working directory on the remote end to the specified path. If no directory is provided, will attempt to change to the root directory ``/''. Relative directories are understood, and you can provide a pathname of ``..'' to move up one level.

$ftp->hash($flag)
You can turn hash printing on and off any time after creating the FTP object with the hash() method.

$directory = $ftp->pwd
Returns the full pathname of the current working directory on the remote end.

$success = $ftp->rmdir($directory)
Remove the specified directory, provided you have sufficient privileges to do so.

$success = $ftp->mkdir($directory [,$parents])
Creates a new directory at the indicated path, provided you have sufficient privileges to do so. If $parents is true, Net::FTP will attempt to create all missing intermediate directories as well.

@items = $ftp->ls([$directory])
Get a short-format directory listing of all the files and subdirectories in the indicated directory, or the current working directory if not specified. In a scalar context, ls() will return a reference to an array rather than the list itself.

By default, each member of the returned list consists of just the bare file or directory name. However, since the FTP daemon just passes the argument to the ls command, you are free to pass command-line arguments to ls. For example, this will return a long listing:

  @items = $ftp->ls('-lF');

@items = $ftp->dir([$directory])
Get a long-format directory listing of all the files and subdirectories in the indicated directory, or the current working directory if not specified. In a scalar context, dir() will return a reference to an array rather than the list itself.

In contrast to ls(), each member of the returned list is a line of a directory listing that provides the file modes, ownerships, and sizes. It is equivalent to calling the ls command with the -lg options.

$success = $ftp->get($remote [,$local [, $offset]])
The get() method retrieves the file named $remote from the FTP server. You may provide a full pathname or one relative to the current working directory.

The $local argument specifies the local pathname to store the retrieved file to. If not provided, Net::FTP will create a file with the same name as the remote file in the current directory. You may also pass a filehandle in $local, in which case the contents of the retrieved file will be written to that handle. This is handy for sending files to STDOUT:

  $ftp->get('RECENT',\*STDOUT)

The $offset argument can be used to restart an interrupted transmission. It gives a position within the file that the FTP server should seek to before transmitting. Here's an idiom for using it to restart an interrupted transmission:

  my $offset = (stat($file))[7] || 0;
  $ftp->get($file,$file,$offset);

The call to stat() fetches the current size of the local file, or 0 if it does not exist. This is then used as the offset to get().

$fh = $ftp->retr($filename)
Like get(), the retr() method can be used to retrieve a remote file. However, rather than writing the file to a filehandle or disk file, it returns a filehandle that can be read from to retrieve the file directly. For example, here is how to read the file named ``RECENT'' located on a remote FTP server without creating a temporary local file:
  $fh = $ftp->retr('REMOTE') or die "can't get file ",$ftp->message;
  print while <$fh>;

$success = $ftp->put($local [,$remote])
$remote_name = $ftp->put_unique($local [,$remote])
The put() method transfers a file from the local host to the remote host. The naming rules for $local and $remote are identical to get(), including the ability to use a filehandle for $local.

Put_unique() works like put(), except that if the remote file already exists, a new one with a unique name based on the requested name will be created. This unique name will be returned by the method call, or can be retrieved at a later date using the unique_name() method.

$fh = $ftp->stor($filename)
$fh = $ftp->appe($filename)
$fh = $ftp->stou($filename)
These three methods initiate file uploads. The file will be stored on the remote server under the name $filename. If the remote server allows the transfer, the method will return a filehandle that can be used to transmit the file contents. The methods differ in how they handle the case of an existing file with the specified name. The stor() method will overwrite the existing file, appe() will append to it, and stou() will create a unique filename based on the requested one.

In the case of stou(), the unique_name() method can be used to return the name of the file that was created on the remote host. For reasons having to do with the way stou() is implemented, you must call the filehandle's close() method using the object-oriented syntax before trying to recover the unique filename.

$modtime = $ftp->mdtm($file)
The mdtm() method returns the modification time of the specified file, expressed as seconds since the epoch (the same format returned by the stat() function). If the file does not exist or is not a plain file, then this method returns undef. Also be aware that some older FTP servers (such as those from Sun) do not support retrieval of modification times. These servers will return undef.

$size = $ftp->size($file)
Returns the size of the specified file in bytes. If the file does not exist or is not a plain file, then this method returns undef. Also be aware that older FTP servers that do not support the SIZE command will also return undef.

$name = $ftp->unique_name()
The unique_name() method returns the name of the file created by the most recent put_unique() or stou() method.

Net::FTP is a subclass of both the IO::Socket::INET and Net::Cmd classes. Net::Cmd provides generic methods for dealing with line-oriented servers. Two commonly-used methods are inherited from Net::Cmd:

$message = $ftp->message
Returns the text of the last message from the server. This is particularly useful for figuring out what might have caused an error.

$code = $ftp->code
Returns the last numeric message code from the server. While the message text is not guaranteed to be the same between FTP servers, the message code is set in stone by the FTP protocol. The status codes are listed in FTP RFC 959 (see Appendix D).

By virtue of inheriting from IO::Socket::INET, you can call any of the familiar IO::Socket methods with Net::FTP objects.

A Directory Mirror Script

Using Net::FTP, we can write a simple FTP mirroring script. It will recursively compare a local directory against a remote one and copy new or updated files to the local machine, preserving the directory structure. The program will preserve file modes in the local copy (but not ownerships) and will also make an attempt to preserve symbolic links.

The script, called ftp_mirror.pl, is listed in Figure 6.2. To mirror a file or directory from a remote server, invoke the script with a command-line argument consisting of the remote server's DNS name, a colon, and the path of the file or directory to mirror. For example, this will mirror the file RECENT, copying it to the local directory only if it has changed since the last time the file was mirrored:

  ftp_mirror.pl ftp.perl.org:/pub/CPAN/RECENT

This will mirror the entire contents of the CPAN modules directory, recursively copying the remote directory structure into the current local working directory (don't try this verbatim unless you have a fast network connection and a lot of free disk space):

  ftp_mirror.pl ftp.perl.org:/pub/CPAN/

The script's command-line options include --user and --pass, to provide a username and password for non-anonymous FTP, --verbose for verbose status reports, and --hash to print out hash marks during file transfers.

Lines 1-5: Load modules
We load the Net::FTP module, as well as File::Path and Getopt::Long. File::Path provides the mkpath() routine for creating a subdirectory with all its intermediate parents. Getopt::Long provides functions for managing command line arguments.

Lines 6-19: Process command-line arguments
We process the command-line arguments, using them to set various global variables. The FTP host and the directory or file to mirror are stored into the variables $HOST and $PATH, respectively.

Line 20-23: Initialize the FTP connection
We call Net::FTP->new() to connect to the desired host, and login() to log in. If no username and password were provided as command line arguments, we attempt an anonymous login. Otherwise, we attempt to use the authentication information to log in.

After successfully logging in, we set the file transfer type to binary, which is necessary if we want to exactly mirror the remote site, and we turn on hashing if requested.

Lines 24-26: Initiate mirroring
If all has gone well, we begin the mirroring process by calling an internal subroutine do_mirror() with the requested path. When do_mirror() is done, we close the connection politely by calling the FTP object's quit() method and exit.

Lines 27-36: do_mirror() subroutine
The do_mirror() subroutine is the main entry point for mirroring a file or directory. When first called, we do not know whether the path requested by the user is a file or directory, so the first thing we do is to invoke a utility subroutine to make that determination. Given a path on a remote FTP server, find_type() returns a single-character code indicating the type of object the path points to, a ``-'' for an ordinary file, or a ``d'' for a directory.

Having determined the type of the object, we split the path into the directory part (the prefix) and the last component of the path (the leaf; either the desired file or directory). We invoke the FTP object's cwd() method to change into the parent of the file or directory to mirror.

If the find_type() subroutine indicated that the path is a file, we invoke get_file() to mirror the file. Otherwise we invoke get_dir().

Lines 37-53: get_file() subroutine
This subroutine is responsible for fetching a file, but only if it is newer than the local copy, if any. After fetching the file, we will try to change its mode to match the mode on the remote site. The mode may be provided by the caller (either do_mirror() or the get_dir() subroutine); if not, we determine the mode from within the subroutine.

We begin by fetching the modification time and the size of the remote file using the FTP object's mdtm() and size() methods. Remember that these methods might return undef if we are talking to an older server that doesn't support these calls. If the mode hasn't been provided for us by the caller, we invoke the FTP object's dir() method to generate a directory listing of the requested file, and pass the result to parse_listing(), which splits the directory listing line into a three-element list consisting of the file type, name, and mode.

We now look for a file on the local machine with the same relative path and stat() it, capturing the local file's size and modification time information. We then compare the size and modification time of the remote file to the local copy. If the files are the same time, and the remote file is as old or older than the local one, then we don't need to freshen our copy. Otherwise, we invoke the FTP object's get() method to fetch the remote file. After the file transfer is successfully complete, we change the file's mode to match the remote version.

Lines 54-73: get_dir() subroutine, recursive directory mirroring
The get_dir() subroutine is more complicated than get_file() because it must call itself recursively in order to make copies of directories nested within it. Like get_file(), this subroutine is called with the path of the directory and, optionally, the directory mode.

We begin by creating a local copy of the directory in the current working directory if there isn't one there already, using mkpath() to create intermediate directories if necessary. We then enter the newly-created directory with the chdir() Perl built-in, and change the directory mode if requested.

We retrieve the current working directory at the remote end by calling the FTP object's pwd() method. This path gets stored into a local variable for safe keeping. We now enter the remote copy of the mirror directory using cwd().

We now need to copy the contents of the mirrored directory to the local server. We invoke the FTP object's dir() method to generate a full directory listing. We parse each line of the listing into its type, pathname and mode using the parse_listing() subroutine. Plain files are passed to get_file(), symbolic_links() to make_link(), and subdirectories are passed recursively to get_dir().

Having dealt with each member of the directory listing, we put things back the way they were before we entered the subroutine. We call the FTP oject's cwd() routine to make the old remote working directory current, and chdir('..') to move up a level in the local directory structure as well.

Lines 74-84: find_type() subroutine
Find_type() is a not-entirely-satisfactory subroutine for guessing the type of a file or directory given only its path. We would prefer to use the FTP dir() method for this purpose, as is used in the preceding get_dir() call, but slight differences in the way that the directory command works on different servers when you pass it the path to a file versus the path to a directory, makes this unreliable.

Instead, we test whether the remote path is a directory by trying to cwd() into it. If cwd() fails, we assume that the path is a file. Otherwise we assume that the path is a directory. Note that by this criterion, a symbolic link to a file is treated as a file, and a symbolic link to a directory is treated as a directory. This is the desired behavior.

Lines 85-92: make_link() subroutine
The make_link() subroutine tries to create a local symbolic link that mirrors a remote one. It works by assuming that the entry in the remote directory listing denotes the source and target of a symbolic link like this:
   README.html -> index.html

We split the entry into its two components and pass them to the symlink() built-in. Only symbolic links that point to relative targets are created. We don't attempt to link to absolute paths (such as ``/CPAN'') since this will most likely not be valid on the local machine. Besides, it's a security issue.

Lines 93-106: parse_listing() subroutine
The parse_listing() subroutine is invoked by get_dir() to process one line of the directory listing retrieved by Net::FTP->dir(). This subroutine is necessitated by the fact that the vanilla FTP protocol doesn't provide any other way of determining the type or mode of an element in a directory listing. The subroutine parses the directory entry using a regular expressions that allows for a number of common directory listing variants. The file's type code is derived from the first character of the symbolic mode field (for instance the ``d'' in ``drwxr-xr-x''), and its mode from the remainder of the field. The file name is whatever follows the date field

The type, name and mode are returned to the caller, after first converting the symbolic file mode into its numeric form.

Lines 107-122: filemode() subroutine
This subroutine is responsible for converting a symbolic file mode into its numeric equivalent. For example, the symbolic mode ``rw-r--r--'' becomes octal 0644. We make no attempt to recognize or convert the setuid or setgid bits, which might be a security risk.

Figure 6.2: The ftp_mirror.pl script
 0    #!/usr/bin/perl -w
 1    # file: ftp_mirror.pl
 2    use strict;
 3    use Net::FTP;
 4    use File::Path;
 5    use Getopt::Long;
 6    use constant USAGEMSG => <<USAGE;
 7    Usage: ftp_mirror.pl [options] host:/path/to/directory
 8    Options: 
 9            --user  <user>  Login name
 10           --pass  <pass>  Password
 11           --hash          Progress reports
 12           --verbose       Verbose messages
 13   USAGE
 14   my ($USERNAME,$PASS,$VERBOSE,$HASH);
 15   die USAGEMSG unless GetOptions('user=s'  => \$USERNAME,
 16                                  'pass=s'  => \$PASS,
 17                                  'hash'    => \$HASH,
 18                                  'verbose' => \$VERBOSE);
 19   die USAGEMSG unless my ($HOST,$PATH) = $ARGV[0]=~/(.+):(.+)/;
 20   my $ftp = Net::FTP->new($HOST) or die "Can't connect: $@\n";
 21   $ftp->login($USERNAME,$PASS)   or die "Can't login: ",$ftp->message;
 22   $ftp->binary;
 23   $ftp->hash(1) if $HASH;
 24   do_mirror($PATH);
 25   $ftp->quit;
 26   exit 0;
 27   # top-level entry point for mirroring.
 28   sub do_mirror {
 29     my $path = shift;
 30     return unless my $type = find_type($path);
 31     my ($prefix,$leaf) = $path =~ m!^(.*?)([^/]+)/?$!;
 32     $ftp->cwd($prefix) if $prefix;
 33     return get_file($leaf)  if $type eq '-';  # ordinary file
 34     return get_dir($leaf)   if $type eq 'd';  # directory
 35     warn "Don't know what to do with a file of type $type. Skipping.";
 36   }
 37   # mirror a file
 38   sub get_file {
 39     my ($path,$mode) = @_;
 40     my $rtime = $ftp->mdtm($path);
 41     my $rsize = $ftp->size($path);
 42     $mode = (parse_listing($ftp->dir($path)))[2] unless defined $mode;
 43     my ($lsize,$ltime) = stat($path) ? (stat(_))[7,9] : (0,0);
 44     if ( defined($rtime) and defined($rsize) 
 45          and ($ltime >= $rtime) 
 46          and ($lsize == $rsize) ) {
 47       warn "Getting file $path: not newer than local copy.\n" if $VERBOSE;
 48       return;
 49     }
 50     warn "Getting file $path\n" if $VERBOSE;
 51     $ftp->get($path) or (warn $ftp->message,"\n" and return);
 52     chmod $mode,$path if $mode;
 53   }
 54   # mirror a directory, recursively
 55   sub get_dir {
 56     my ($path,$mode) = @_;
 57     my $localpath = $path;
 58     -d $localpath or mkpath $localpath or die "mkpath failed: $!";
 59     chdir $localpath                   or die "can't chdir to $localpath: $!";
 60     chmod $mode,'.' if $mode;
 61     my $cwd = $ftp->pwd                or die "can't pwd: ",$ftp->message;
 62     $ftp->cwd($path)                   or die "can't cwd: ",$ftp->message;
 63     warn "Getting directory $path/\n" if $VERBOSE;
 64     foreach ($ftp->dir) {
 65       next unless my ($type,$name,$mode) = parse_listing($_);
 66       next if $name =~ /^(\.|\.\.)$/;  # skip . and ..
 67       get_dir ($name,$mode)    if $type eq 'd';
 68       get_file($name,$mode)    if $type eq '-';
 69       make_link($name)         if $type eq 'l';
 70     }
 71     $ftp->cwd($cwd)     or die "can't cwd: ",$ftp->message;
 72     chdir '..';
 73   }
 74   # subroutine to determine whether a path is a directory or a file
 75   sub find_type {
 76     my $path = shift;
 77     my $pwd = $ftp->pwd;
 78     my $type = '-';  # assume plain file
 79     if ($ftp->cwd($path)) {
 80       $ftp->cwd($pwd);
 81       $type = 'd';
 82     }
 83     return $type;
 84   }
 85   # Attempt to mirror a link.  Only works on relative targets.
 86   sub make_link {
 87     my $entry = shift;
 88     my ($link,$target) = split /\s+->\s+/,$entry;
 89     return if $target =~ m!^/!;
 90     warn "Symlinking $link -> $target\n" if $VERBOSE;
 91     return symlink $target,$link;
 92   }
 93   # parse directory listings 
 94   # -rw-r--r--   1 root     root          312 Aug  1  1994 welcome.msg
 95   sub parse_listing {
 96     my $listing = shift;
 97     return unless my ($type,$mode,$name) =
 98       $listing =~ /^([a-z-])([a-z-]{9})  # -rw-r--r--
 99                    \s+\d*                # 1
 100                   (?:\s+\w+){2}         # root root
 101                   \s+\d+                # 312
 102                   \s+\w+\s+\d+\s+[\d:]+ # Aug 1 1994
 103                   \s+(.+)               # welcome.msg
 104                   $/x;           
 105    return ($type,$name,filemode($mode));
 106  }
 107  # turn symbolic modes into octal
 108  sub filemode {
 109    my $symbolic = shift;
 110    my (@modes) = $symbolic =~ /(...)(...)(...)$/g;
 111    my $result;
 112    my $multiplier = 1;
 113    while (my $mode = pop @modes) {
 114      my $m = 0;
 115      $m += 1 if $mode =~ /[xsS]/;
 116      $m += 2 if $mode =~ /w/;
 117      $m += 4 if $mode =~ /r/;
 118      $result += $m * $multiplier if $m > 0;
 119      $multiplier *= 8;
 120    }
 121    $result;
 122  }

When we run the mirror script in verbose mode on CPAN, the beginning of the output looks like this:

 % ftp_mirror.pl --verbose ftp.perl.org:/pub/CPAN
 Getting directory CPAN/
 Symlinking CPAN.html -> authors/Jon_Orwant/CPAN.html
 Symlinking ENDINGS -> .cpan/ENDINGS
 Getting file MIRRORED.BY
 Getting file MIRRORING.FROM
 Getting file README
 Symlinking README.html -> index.html
 Symlinking RECENT -> indices/RECENT-print
 Getting file RECENT.html
 Getting file ROADMAP
 Getting file ROADMAP.html
 Getting file SITES
 Getting file SITES.html
 Getting directory authors/
 Getting file 00.Directory.Is.Not.Maintained.Anymore
 Getting file 00upload.howto
 Getting file 00whois.html
 Getting file 01mailrc.txt.gz
 Symlinking Aaron_Sherman -> id/ASHER
 Symlinking Abigail -> id/ABIGAIL
 Symlinking Achim_Bohnet -> id/ACH
 Symlinking Alan_Burlison -> id/ABURLISON
 ...

When we run it again a few minutes later, we see messages indicating that most of the files are current and don't need to be updated:

 % ftp_mirror.pl --verbose ftp.perl.org:/pub/CPAN
 Getting directory CPAN/
 Symlinking CPAN.html -> authors/Jon_Orwant/CPAN.html
 Symlinking ENDINGS -> .cpan/ENDINGS
 Getting file MIRRORED.BY: not newer than local copy.
 Getting file MIRRORING.FROM: not newer than local copy.
 Getting file README: not newer than local copy.
 ...

The major weak point of this script is the parse_listing() routine. Because the FTP directory listing format is not standardized, server implementations vary slightly. During development, I tested this script on a variety of Unix FTP daemons as well as the Microsoft IIS FTP server. However, this script may well fail with other servers. In addition, the regular expression used to parse directory entries will most likely fail on filenames that begin with whitespace.


Net::Telnet

FTP is the quintessential line-oriented server application. Every command issued by the client takes the form of a single, easily-parsed line, and each response from the server to the client follows a predictable format. Many of the server applications that we discuss later in this chapter, including POP, SMTP and HTTP are similarly simple. This is because the applications were designed to interact primarily with software, not with people.

Telnet is almost exactly the opposite. It was designed to interact directly with people, not software. The output from a telnet session is completely unpredictable, depending on how the remote host is configured, what shell the user has installed, and how the user's environment is set up.

Telnet does several things that make it easier to use by human beings: it puts its output stream into a mode that echoes back all commands that are sent to it, allowing people to see what they type, and it puts its input stream into a mode that allows it to read and respond to a character at a time. This allows command-line editing, and full-screen text applications to work. Telnet responds to certain control characters, allowing ^C and ^Z to be converted into signals and transmitted to the current process.

While these features make it easy for humans to use Telnet-based applications, it makes scripting such applications a major challenge. Because the telnet protocol is more complex than sending commands and receiving responses, you can't simply connect a socket to port 23 (telnet's default port) on a remote machine and start exchanging messages. Before the telnet client and server can talk, they must engage in a complex handshake procedure to negotiate communications session parameters. Nor is it possible for a Perl script to open a pipe to the telnet client program itself because the telnet, like many interactive proteins, expects to be opened on a terminal device and tries to change the characteristics of the device using various ioctl() calls.

Given these factors, it's best to avoid writing clients for interactive applications. Sometimes, though, it's unavoidable. You may need to automate a legacy application that is available only as an interactive terminal application. Or you may need to remotely drive a system utility that is only accessible in interactive form. A classic example of the latter is the Unix passwd program for changing users' login passwords. Like telnet, passwd expects to talk directly to a terminal device, and you must do special work to successfully drive it from a Perl script.

The Net::Telnet module provides access to telnet-based services. With its facilities, you can log into a remote host via the telnet protocol, run commands, and act on the results using a straightforward pattern-matching idiom. When combined with the IO::Pty module, you can also use Net::Telnet to control local interactive programs.

Net::Telnet was written by Jay Rogers and is available on CPAN. It is a pure Perl module, and will run unmodified on Windows and Macintosh systems. Although it was designed to interoperate with Unix telnet daemons, it is known to work with the Windows NT telnet daemon available on the Network Resource Kit CD and several of the freeware daemons.

A Simple Net::Telnet Example

Figure 6.3 shows a simple script that uses Net::Telnet. It logs into a host, runs the command ps -ef to list all running processes, and then echoes the information to standard output.

Lines 1-3: Load modules
We load the Net::Telnet module. It is entirely object-oriented, so there are no symbols to import.

Lines 4-6: Define constants
We hard-code constants for the host to connect to, and the user and password to log in as (no, this isn't my real password!). You'll need to change these as appropriate for your system.

Line 7: Create a new Net::Telnet object
We call Net::Telnet->new() with the name of the host. Net::Telnet will attempt to connect to the host, returning a new Net::Telnet object if successful, or undef if a connection could not be established.

Line 8: Log in to remote host
We call the Telnet object's login() method with the username and password. Login() will attempt to log in to the remote system, and will return true if successful.

Line 9-10: Run the ``ps'' command
We invoke the cmd() method with the command to run, in this case ps -ef. If successful, this method returns an array of lines containing the output of the command (including the newlines). We print the result to standard output.

When we run the remoteps1.pl script, there is a brief pause while the script logs into the remote host, and then the output of the ps command appears:

 89% remoteps1.pl
 UID        PID  PPID  C STIME TTY          TIME CMD
 root         1     0  0 Jun26 ?        00:00:04 init
 root         2     1  0 Jun26 ?        00:00:15 [kswapd]
 root         3     1  0 Jun26 ?        00:00:00 [kflushd]
 root         4     1  0 Jun26 ?        00:00:01 [kupdate]
 root        34     1  0 Jun26 ?        00:00:01 /sbin/cardmgr
 root       114     1 30 Jun26 ?        19:18:46 [kapmd]
 root       117     1  0 Jun26 ?        00:00:00 [khubd]
 bin        130     1  0 Jun26 ?        00:00:00 /usr/sbin/rpc.portmap
 root       134     1  0 Jun26 ?        00:00:25 /usr/sbin/syslogd
 ...
Figure 6.3: remoteps1.pl logs into a remote host and runs the ``ps'' command
 0    #!/usr/bin/perl
 1    # file: remoteps1.pl
 2    use strict;
 3    use Net::Telnet;
 4    use constant HOST => 'phage.cshl.org';
 5    use constant USER => 'lstein';
 6    use constant PASS => 'xyzzy';
 7    my $telnet = Net::Telnet->new(HOST);
 8    $telnet->login(USER,PASS);
 9    my @lines = $telnet->cmd('ps -ef');
 10   print @lines;

Net::Telnet API

In order to accomodate the many differences between telnet implementations and shells among operating systems, the Net::Telnet module has a large array of options. We will only consider the most frequently used of them here. See the Net::Telnet documentation for the full details.

Net::Telnet methods generally have both a named-argument form and a ``shortcut'' form that takes a single argument only. For example, new() can be called either this way:

    my $telnet = Net::Telnet->new('phage.cshl.org');

or like this:

    my $telnet = Net::Telnet->new(Host=>'phage.cshl.org', Timeout=>5);

We show both forms when appropriate.

$telnet = Net::Telnet->new($host)
$telnet = Net::Telnet->new(Option1=>$value1,Option2=>$value2 ..)
The new() method creates a new Net::Telnet object. It may be called with a single argument containing the name of the host to connect to, or with a series of option/value pairs that provide finer control over the object. new() recognizes many options, the most common of which are shown here:
  Option           Description                      Default value
  Host             Host to connect to               "localhost"
  Port             Port to connect to               23
  Timeout          Timeout for pattern matches,     10
                   in seconds.
  Binmode          Suppress CRLF translation        false
  Cmd_remove_mode  Remove echoed command from       "auto"
                   input
  Errmode          Set the error mode               "die"
  Input_log        Log file to write input to       none
  Fhopen           Filehandle to communicate over   none
  Prompt           Command-line prompt to match      "/[\$%#>] $/"

B<Host> and B<Port> are the host and port to connect to, and
B<Timeout> is the period in seconds that Net::Telnet will wait between
waiting for an expected pattern and declaring a timeout.

Binmode controls whether Net::Telnet will perform CRLF translation. By default (Binmode=>0), every newline sent from the script to the remote host is translated into a CRLF pair, just as the telnet client does it. Likewise, every CRLF received from the remote host is translated into a newline. With Binmode set to a true value, this translation is suppressed and data is transmitted verbatim.

Cmd_remove_mode controls the removal of echoed commands. Most implementations of the telnet server echo back all user input. As a result, text you send to the server will reappear in the data read back from the remote host. If Cmd_remove_mode is set to true, the first line of all data received from the server will be stripped. A false value will prevent stripping, and a value of ``auto'' will allow Net::Telnet to decide for itself whether to strip based on the ``echo'' setting during the initial telnet handshake.

Errmode determines what happens when an error occurs, typically an expected pattern not being seen before the timeout. The value of Errmode can be one of the strings ``die'' (the default) or ``return''. When set to ``die'', Net::Telnet will die on an error, aborting your program. A value of ``return'' modifies this behavior, so that instead of dying the failed method returns undef. You can then recover the specific error message using errmsg(). In addition to these two strings, Errmode accepts either a code reference or an array reference. Both of these forms are used to install custom handlers that will be invoked when an error occurs. The Net::Telnet documentation provides further information.

The value for Input_log should be a file name or a filehandle. All data received from the server will be echoed to this file or filehandle. Since the received data usually contains the echoed command, this is a way to capture a transcript of the Net::Telnet session and is invaluable for debugging. If the argument is a previously opened filehandle, then the log will be written to that filehandle. Otherwise, the argument is treated as the name of a file to open or create.

The Fhopen argument can be used to pass a previously opened filehandle to Net::Telnet for it to use in communication. Net::Telnet will use this filehandle instead of trying to open its own connection. We will use this later to coerce Net::Telnet into working across a Secure Shell link.

Lastly, Prompt sets the regular expression that Net::Telnet uses to identify the shell command-line prompt. This is used by the login() and cmd() methods to determine that the command ran to completion. By default, Prompt is set to a pattern that matches the default sh, csh, ksh and tcsh prompts.

$result = $telnet->login($username,$password)
$result = $telnet->login(Name => $username, Password => $password, [ Prompt => $prompt, ] [ Timeout => $timeout] )
The login() method attempts to log into the remote host using the provided username and password. In the named-parameter form of the method call, you may override the values of Prompt and Timeout provided to new().

If the Errmode is ``die'' and the login method encounters an error, the call will abort your script with an error message. Otherwise, login() will return false.

$result = $telnet->print(@values)
Print a value or list of values to the remote host. A newline will automatically be added for you unless you explicitly disable this feature (see the Net::Telnet documentation for detals). The method will return true if all of the data was successfully written.

It is also possible to bypass Net::Telnet's character translation routines and write directly to the remote host by using the Net::Telnet object as a filehandle:

 print $telnet "ls -lF\015\012";

$result = $telnet->waitfor($pattern)
($before,$match) = $telnet->waitfor($pattern)
($before,$match) = $telnet->waitfor([Match=>$pattern,] [String=>$string,] [Timeout=>$timeout])
The waitfor() method is the workhorse of Net::Telnet. It waits up to Timeout seconds for the specified string or pattern to appear on the data stream coming from the remote host. In a scalar context, waitfor() returns a true value if the desired pattern was seen. In a list context, the method returns a two-element list consisting of the data seen before the match and the matched string itself.

You can give waitfor() a regular expression to pattern match or a simple string, in which case Net::Telnet will use index() to scan for it in incoming data. In the method's named argument form, use the Match argument for a pattern match, and String for a simple string match. You can specify multiple alternative patterns or strings to match simply by providing more than one Match and/or String arguments.

The strings used for be correctly delimited Perl pattern match operators. For example ``/bash> $/'' and ``m(bash> $)'' will both work, but ``bash> $'' won't because of the absence of pattern match delimiters.

In the single-argument form of waitfor(), the argument is a pattern match. The Timeout argument may be used to override the default timeout value.

This code fragment will issue a ``ls -lF'' command, wait for the command line prompt to appear, and print out what came before the prompt, which ought to be the output of the ``ls'' command:

  $telnet->print('ls -lF');
  ($before,$match) = $telnet->waitfor('/[$%#>] $/');
  print $before;

$result = $telnet->cmd($command)
@lines = $telnet->cmd($command)
@lines = $telnet->cmd(String=>$command, [Output=>$ref,] [Prompt=>$pattern,] [Timeout=>$timeout,] [Cmd_remove_mode=>$mode]
The cmd() method is used to send a command to the remote host and return its output, if any. It is equivalent to a print() of the command, followed by a waitfor() using the default shell prompt pattern.

In a scalar context, cmd() returns true if the command executed successfully, false if the method timed out before the shell prompt was seen. In a list context, this method returns all the lines received prior to matching the prompt.

In the named-argument form of the call, the Output argument designates either a scalar or array reference to receive the lines that preceded the match. The Prompt, Timeout, and Cmd_remove_mode arguments allow you to override the corresponding settings.

Note that a true result from cmd() does not mean that the command executed successfully. It only means that the command completed in the time allotted for it.

$data = $telnet->get([Timeout=>$timeout])
The get() method performs a timed read on the telnet session, returning any data that is available. If no data is received within the allotted time, the method will die if Errmode is set to ``die'' or return undef otherwise. The get() method also returns undef on end-of-file (indicating that the remote host has closed the telnet session). You can use eof() and timed_out() to distinguish these two possibilities.

$line = $telnet->getline([Timeout=>$timeout])
The getline() method will read the next line of text from the telnet session. Like get(), it will return undef on either a timeout or an end-of-file. You may change the module's notion of the input record separator using the input_record_separator() method, described below.

@lines = $telnet->getlines([Timeout=>$timeout])
Return all available lines of text, or an empty list on timeout or end-of-file.

$msg = $telnet->errmsg
This method returns the error message associated with a failed method call. For example, after a timeout on on a waitfor(), the errmsg() will return ``pattern match timed-out''.

$line = $telnet->lastline
This method returns the last line read from the object. It's useful to examine this value after the remote host has unexpectedly terminated the connection because it might contain clues to the cause of this event.

$value = $telnet->input_record_separator([$newvalue])
$value = $telnet->output_record_separator([$newvalue])
These two methods get and/or set the input and output record separators. The input record separator is used to split input into lines, and is used by the getline(), getlines() and cmd() methods. The output record separator is printed at the end of each line output by the print() method. Both values are ``\n'' by default.

$value = $telnet->prompt([$newvalue])
$value = $telnet->timeout([$newvalue])
$value = $telnet->binmode([$newvalue])
$value = $telnet->errmode([$newvalue])
These methods get and/or set the corresponding settings, and can be used to examine or change the defaults after the Telnet object is created.

$telnet->close
The close() method severs the connection to the remote host.

A Remote Password Changing Program

As a practical example of using Net::Telnet, we'll develop a remote password changing script named change_passwd.pl. This script will contact each of the hosts named on the command line in turn and change the user's login password. This might be useful for someone who has accounts on a lot of different machines that don't share the same authentication database.

The script is used like this:

 % change_passwd.pl --old=mothergOOse --new=bopEEp chiron masdorf sceptre.yoyo.com

This command line requests the script to change the current user's password on the three machines ``chiron,'' ``masdorf'' and ``sceptre.yoyo.com''. The script will report success or failure to change the password on each of the indicates machines.

The script uses the UNIX passwd program to do its work. In order to drive passwd, we need to anticipate its various prompts and errors. Here's a sample of a successful interaction:

  % passwd
  Changing password for lstein
  Old password: *******
  Enter the new password (minimum of 5, maximum of 8 characters)
  Please use a combination of upper and lower case letters and numbers.
  New password: *******
  Re-enter new password: *******
  Password changed.

At the three ``password: '' prompts I typed my current and new passwords. However, the passwd program turns off terminal echo so that the passwords don't actually display on the screen.

A number of errors may occur during execution of passwd. In order to be robust, the password-changing script must detect them. One error is when the original password is typed incorrectly:

 % passwd
 Changing password for lstein
 Old password: *******
 Incorrect password for lstein.
 The password for lstein is unchanged.

Another error occurs when the new password doesn't satisfy the passwd program's criteria for a ``good'' password:

 % passwd
 Changing password for lstein
 Old password: *******
 Enter the new password (minimum of 5, maximum of 8 characters)
 Please use a combination of upper and lower case letters and numbers.
 New password: hi                      [editor: use overstrike font here]
 Bad password: too short.  Try again.
 New password: aaaaaaaaaa              [editor: use overstrike font here]
 Bad password: a palindrome.  Try again.
 New password: 12345                   [editor: use overstrike font here]
 Bad password: too simple.  Try again.

This example shows several attempts to set the password, each one rejected for various reasons. The common part of the error message is ``Bad password.'' However, we don't have to worry about a third common error in running passwd, which is failing to type the password correctly at the confirmation prompt.

The change_passwd.pl script is listed in Figure 6.4,

Lines 1-4: Load modules
We load Net::Telnet and the Getopt::Long module for command line option parsing.

Lines 5-12: Define constants
We create a DEBUG flag. If this is true, then we will instruct the Net::Telnet module to log all its input to a file named ``passwd.log''. This file will contain password information, so be sure to delete it promptly. The USAGE constant contains the usage statement printed when the user fails to provide the correct command-line options.

Lines 13-19: Parse command line options
We call GetOptions() to parse the command line options. We default to the current user's login name if none is provided explicitly using the LOGNAME environment variable. The old and new password options are mandatory.

Line 20: Invoke change_passwd() subroutine
For each of the machines named on the command line, we invoke an internal subroutine named change_passwd(), passing it the name of the machine, the user login name, and the old and new passwords.

Lines 21-25: change_passwd() subroutine
Most of the work happens in change_passwd(). We begin by opening up a new Net::Telnet object on the indicated host, and store the object in a variable named $shell. If DEBUG is set, we turn on logging to a hard-coded file. We also set errmode() to ``return'' so that Net::Telnet calls will return false rather than dying on an error.

We now call login() to attempt to log in with the user's account name and password. If this fails, we return with a warning constructed from the Telnet object's errmsg() routine.

Otherwise we are at the login prompt of the user's shell. We invoke the passwd command and wait for the expected ``Old password:'' prompt. If the prompt appears within the timeout limit we send the old password to the server. Otherwise, we return with an error message.

Two outcomes are possible at this point. The passwd program may accept the password and prompt us for the new password; or it may reject the password for some reason. We wait for either of the prompts to appear, and then examine the match string returned by waitfor() to determine which of the two patterns we matched. In the former case, we proceed to provide the new password. In the latter, we return with an error message.

After printing the new desired password (line 33) there are again two possibilities: passwd may reject the proposed password because it is too simple, or it may accept it and prompt us to confirm the new password. We handle this in the same way as before.

The last step is to print the new password again, confirming the change. We do not expect any errors at this point, but we do wait for the ``Password changed.'' confirmation before reporting success.

Because there is little standardization among passwd programs, this script is likely to work only with those variants of Unix that use a passwd program closely derived from the original BSD version. To handle other passwd variants, you will need to modify the pattern matches appropriately by including other Match patterns in the calls to waitfor().

Running change_passwd.pl on a network of Linux systems gives output like this:

 % change_passwd.pl --user=george --old=m00nd0g --new=swampH0und \
                    localhost pesto prego romano
 Password changed for george on localhost.
 Password changed for george on pesto.
 Password changed for george on prego.
 Password changed for george on romano.
Figure 6.4: Remote password changing script
 0    #!/usr/bin/perl
 1    # file: change_passwd.pl
 2    use strict;
 3    use Net::Telnet;
 4    use Getopt::Long;
 5    use constant DEBUG => 1;
 6    use constant USAGEMSG => <<USAGE;
 7    Usage: change_passwd.pl [options] machine1, machine2, ...
 8    Options: 
 9            --user  <user>  Login name
 10           --pass  <pass>  Current password
 11           --new   <pass>  New password
 12   USAGE
 13   my ($USER,$OLD,$NEW);
 14   die USAGEMSG unless GetOptions('user=s'  => \$USER,
 15                                  'old=s'   => \$OLD,
 16                                  'new=s'   => \$NEW);
 17   $USER ||= $ENV{LOGNAME};
 18   $OLD  or die "provide current password with --old\n";
 19   $NEW  or die "provide new password with --new\n";
 20   change_passwd($_,$USER,$OLD,$NEW) foreach @ARGV;
 21   sub change_passwd {
 22     my ($host,$user,$oldpass,$newpass) = @_;
 23     my $shell = Net::Telnet->new($host);
 24     $shell->input_log('passwd.log') if DEBUG;
 25     $shell->errmode('return');
 26     $shell->login($user,$oldpass) or return warn "$host: ",$shell->errmsg,"\n";
 27     $shell->print('passwd');
 28     $shell->waitfor('/Old password:/') or return warn "$host: ",$shell->errmsg,"\n";
 29     $shell->print($oldpass);
 30     my($pre,$match) = $shell->waitfor(Match => '/Incorrect password/',
 31                                       Match => '/New password:/');
 32     $match =~ /New/ or return warn "$host: Incorrect password.\n";
 33     $shell->print($newpass);
 34     ($pre,$match) = $shell->waitfor(Match => '/Bad password/',
 35                                     Match => '/Re-enter new password:/');
 36     $match =~ /Re-enter/ or return warn "$host: New password rejected.\n";
 37     $shell->print($newpass);
 38     $shell->waitfor('/Password changed\./')
 39       or return warn "$host: ",$shell->errmsg,"\n";
 40     print "Password changed for $user on $host.\n";
 41   }

While change_passwd.pl is running, the old and new passwords will be visible to anyone who runs a ps command to view the command lines of running programs. If you wish to use this script in production, you will probably want to modify it so as to accept this sensitive information from standard input. Another consideration is that the password information is passed ``in the clear'', and therefore vulnerable to network sniffers. The SSH-enabled password changing script in the next section overcomes this difficulty.

Using Net::Telnet for non-Telnet Protocols

Net::Telnet can be used to automate interactions with other network servers. Often it is as simple as providing the appropriate Port argument to the new() call. The Net::Telnet manual page provides an example of doing this with the POP3 protocol, which we discuss later in this chapter.

With help from the IO::Pty module, Net::Telnet can be used to automate more complicated network services or to interact with local programs. Like the telnet client, the issue with these programs is that they were designed to interact with the user and expect access to a terminal device (a TTY). What the IO::Pty module does is to create a ``pseudo-terminal device'' (pseudo-tty) for these programs to use. The pseudo-terminal is basically a bidirectional pipe. One end of the pipe is attached to the interactive program, and from the program's point of view looks and acts like a TTY. The other end of the pipe is attached to your script, and can be used to send data to the program and read its output.

Because the use of pseudo-ttys is a powerful technique that is not well documented, we will show a practical example. Many security-conscious sites have replaced telnet and FTP with the Secure Shell (SSH), a remote login protocol that authenticates and encrypts login sessions using a combination of public key and symmetric cryptography. The change_passwd.pl script won't work with sites that have disabled telnet in favor of SSH, and we would like to use the ssh client to establish the connection to the remote host in order to run the passwd command.

The ssh client emits a slightly different login prompt than telnet. A typical session looks like this:

 % ssh -l george prego
 george@prego's password: *******
 Last login: Mon Jul  3 08:20:28 2000 from localhost
 Linux 2.4.01.
 %

The ssh client takes an optional -l command-line switch to set the name of the user to log in as, and the name of the remote host (we use the short name rather than the fully qualified DNS name in this case). It prompts for the password on the remote host, and then attempts to log in.

In order to work with ssh we will have to make several changes to change_passwd.pl: (1) we will open a pseudo-tty on the ssh client and pass the controlling filehandle to Net::Telnet->new() in the Fhopen argument; (2) we will replace the call to login() with our own pattern matching routine so as to handle ssh's modified login prompt.

The IO::Pty module, available on CPAN, has a simple API:

$pty = IO::Pty->new
The new() method takes no arguments and returns a new IO::Pty pseudo-tty object. The returned object is a filehandle corresponding to the controlling end of the pipe. Your script will ordinarily use this filehandle to send commands and read results from the program you're driving.

$tty = $pty->slave
Given a pseudo-tty created with a call to IO::Pty->new(), the slave() method returns the TTY half of the pipe. You will ordinarily pass this filehandle to the program you want to control.

Figure 6.5 shows the idiom for launching a program under the control of a pseudo-tty. The do_cmd() subroutine accepts the name of a local command to run and a list of arguments to pass it. We begin by creating a pseudo-tty with IO::Pty->new() (line 3). If successful, we fork(), and the parent process returns the pseudo-tty to the caller. The child process, however, has a little more work to do. We first detach from the current controlling TTY by calling POSIX::setsid(). The next step is to recover the TTY half of the pipe by calling the IO::Pty object's slave() method, and close the pseudo-tty half (lines 7-8).

We now reopen STDIN, STDOUT and STDERR on the new TTY object, and close the now-unneeded copy of the filehandle (lines 9-12). We make STDOUT unbuffered and invoke exec() to run the desired command and arguments. When the command runs, its standard input and output will be attached to the new TTY, which in turn will be attached to the pseudo-tty controlled by the parent process.

Figure 6.5: Launching a program in a pseudo-tty
  1 sub do_cmd {
  2   my ($cmd,@args) = @_;
  3   my $pty = IO::Pty->new or die "can't make Pty: $!";
  4   defined (my $child = fork) or die "Can't fork: $!";
  5   return $pty if $child;
  6   POSIX::setsid();
  7   my $tty = $pty->slave;
  8   close $pty;
  9   STDIN->fdopen($tty,"<")      or die "STDIN: $!";
 10   STDOUT->fdopen($tty,">")     or die "STDOUT: $!";
 11   STDERR->fdopen(\*STDOUT,">") or die "STDERR: $!";
 12   close $tty;
 13   $| = 1;
 14   exec $cmd,@args;
 15   die "Couldn't exec: $!";
 16  }

With do_cmd() written, the other changes to change_passwd.pl are relatively minor. Figure 6.6 shows the revised script written to use the ssh client, change_passwd_ssh.pl.

Lines 1-6: Load modules
We now load IO::Pty and the setsid() routine from the POSIX module.

Lines 7-22: Process command-line arguments and call change_passwd()
The only change here is a new constant, PROMPT, that contains the pattern match that we will expect from the user's shell command prompt.

Lines 23-26: Launch ssh subprocess
We invoke do_cmd() to run the ssh program using the requested username and host. If do_cmd() is successful, it will return a filehandle connected to the pseudo-tty driving the ssh subprocess.

Lines 27-30: Create and initialize Net::Telnet object
In the change_passwd() routine, we create a new Net::Telnet object, but now instead of allowing Net::Telnet to open a connection to the remote host directly, we pass it the ssh filehandle using the Fhopen argument. After creating the Net::Telnet object, we configure it by putting it into binary mode with binmode(), setting the input log for debugging, and setting the errormode to ``return''. The use of binary mode is a small but important modification from the original script. Since the SSH protocol terminates its lines with a single LF character rather than CRLF pairs, the default Net::Telnet CRLF translation is inappropriate.

Lines 31-33: Log in
Instead of calling Net::Telnet's built-in login() method, which expects telnet-specific prompts, we roll our own by waiting for the ssh ``password:'' prompt and then providing the appropriate response. We then wait for the user's command prompt. If, for some reason, this fails, we return with an error message.

Lines 34-48: Change password
The remainder of the change_passwd() subroutine is identical to the earlier version.

Lines 49-64: do_cmd() subroutine
We have already examined the do_cmd() subroutine.

Figure 6.6: Changing passwords over a Secure Shell connection
 0    #!/usr/bin/perl
 1    # file: change_passwd_ssh.pl
 2    use strict;
 3    use Net::Telnet;
 4    use Getopt::Long;
 5    use IO::Pty;
 6    use POSIX 'setsid';
 7    use constant PROMPT  => '/[%>] $/';
 8    use constant USAGEMSG => <<USAGE;
 9    Usage: change_passwd.pl [options] machine1, machine2, ...
 10   Options: 
 11           --user  <user>  Login name
 12           --old   <pass>  Current password
 13           --new   <pass>  New password
 14   USAGE
 15   my ($USER,$OLD,$NEW);
 16   die USAGEMSG unless GetOptions('user=s'  => \$USER,
 17                                  'old=s'   => \$OLD,
 18                                  'new=s'   => \$NEW);
 19   $USER ||= $ENV{LOGNAME};
 20   $OLD  or die "provide current password with --old\n";
 21   $NEW  or die "provide new password with --new\n";
 22   change_passwd($_,$USER,$OLD,$NEW) foreach @ARGV;
 23   sub change_passwd {
 24     my ($host,$user,$oldpass,$newpass) = @_;
 25     my $ssh = do_cmd('ssh',"-l$user",$host) 
 26       or die "couldn't launch ssh subprocess";
 27     my $shell = Net::Telnet->new(Fhopen => $ssh);
 28     $shell->binmode(1);
 29     $shell->input_log('passwd.log') if DEBUG;
 30     $shell->errmode('return');
 31     $shell->waitfor('/password: /');
 32     $shell->print($oldpass);
 33     $shell->waitfor(PROMPT) or return "host refused login: wrong password?\n";
 34     $shell->print('passwd');
 35     $shell->waitfor('/Old password:/') or return warn "$host: ",$shell->errmsg,"\n";
 36     $shell->print($oldpass);
 37     my($pre,$match) = $shell->waitfor(Match => '/Incorrect password/',
 38                                       Match => '/New password:/');
 39     $match =~ /New/ or return warn "$host: Incorrect password.\n";
 40     $shell->print($newpass);
 41     ($pre,$match) = $shell->waitfor(Match => '/Bad password/',
 42                                     Match => '/Re-enter new password:/');
 43     $match =~ /Re-enter/ or return warn "$host: New password rejected.\n";
 44     $shell->print($newpass);
 45     $shell->waitfor('/Password changed\./')
 46       or return warn "$host: ",$shell->errmsg,"\n";
 47     print "Password changed for $user on $host.\n";
 48   }
 49   sub do_cmd {
 50     my ($cmd,@args) = @_;
 51     my $pty = IO::Pty->new or die "can't make Pty: $!";
 52     defined (my $child = fork) or die "Can't fork: $!";
 53     return $pty if $child;
 54     setsid();
 55     my $tty = $pty->slave;
 56     close $pty;
 57     STDIN->fdopen($tty,"r")      or die "STDIN: $!";
 58     STDOUT->fdopen($tty,"w")     or die "STDOUT: $!";
 59     STDERR->fdopen(\*STDOUT,"w") or die "STDERR: $!";
 60     close $tty;
 61     $| = 1;
 62     exec $cmd,@args;
 63     die "Couldn't exec: $!";
 64   }

The change_passwd_ssh.pl program now uses the Secure Shell to establish connections to the indicated machines and change the user's password. This is a big advantage over the earlier version, which was prone to network eavesdroppers who could intercept the new password as it passed over the wire in unencrypted form. On multiuser systems you will still probably want to modify the script to read the passwords from standard input rather than from the command line. For completeness, Figure 6.7 lists a routine, prompt_for_passwd() that uses the UNIX stty program to disable command-line echo temporarily while the user is typing the password.

You can use it like this:

  $old = get_password('old password');
  $new = get_password('new password');

A slightly more sophisticated version of this subroutine, which takes advantage of the Term::ReadKey module, if available, appears in Chapter 20.

Figure 6.7: Disabling echo while prompting for a password
 0    sub get_password {
 1      my $prompt = shift || 'password';
 2      print "$prompt: ";
 3      system "stty -echo </dev/tty";
 4      chomp(my $pw = <STDIN>);
 5      system "stty echo </dev/tty";
 6      print "\n";
 7      return $pw;
 8    }

The Expect Module

An alternative to Net::Telnet is the Expect module, which provides similar services for talking to local and remote processes that expect human interaction. Expect implements a rich command language, which among other things can pause the script and prompt the user for information, such as passwords. Expect can be found on CPAN.


Summary

This chapter covered Perl client modules for two of the most widespread application-level protocols, FTP and Telnet. Together they illustrate the extremes of application protocols, from a rigidly defined command language designed to interact with client programs, to a loose interactive environment designed for people.

The Net::FTP module allows you to write scripts to automatically connect to FTP sites, explore their holdings, and selectively download or upload files. Net::Telnet's flexible pattern matching facilities give you the ability to write scripts to automate processes that were primarily designed for the convenience of people rather than software.


Network Programming in Perl: Home Page