4 use vars qw($VERSION @ISA @EXPORT_OK $scp $DEBUG);
8 use String::ShellQuote;
10 use Net::SSH qw(sshopen3);
14 @EXPORT_OK = qw( scp iscp );
23 Net::SCP - Perl extension for secure copy protocol
28 use Net::SCP qw(scp iscp);
29 scp($source, $destination);
30 iscp($source, $destination); #shows command, asks for confirmation, and
31 #allows user to type a password on tty
34 $scp = Net::SCP->new( "hostname", "username" );
36 $scp = Net::SCP->new( { "host"=>$hostname, "user"=>$username } );
37 $scp->get("filename") or die $scp->{errstr};
38 $scp->put("filename") or die $scp->{errstr};
41 $scp->scp($source, $destination);
44 $scp = Net::SCP->new("hostname");
53 Simple wrappers around ssh and scp commands.
59 =item scp SOURCE, DESTINATION
61 Can be called either as a subroutine or a method; however, the subroutine
62 interface is depriciated.
64 Calls scp in batch mode, with the B<-B> B<-p> B<-q> and B<-r> options.
65 Returns false upon error, with a text error message accessable in
68 Returns false and sets the B<errstr> attribute if there is an error.
73 my $self = ref($_[0]) ? shift : {};
74 my($src, $dest, $interact) = @_;
76 $flags .= 'r' unless &_islocal($src) && ! -d $src;
78 if ( ( defined($interact) && $interact )
79 || ( defined($self->{interact}) && $self->{interact} ) ) {
80 @cmd = ( $scp, $flags, $src, $dest );
81 print join(' ', @cmd), "\n";
83 $self->{errstr} = "User declined";
88 @cmd = ( $scp, $flags, $src, $dest );
90 my($reader, $writer, $error ) =
91 ( new IO::Handle, new IO::Handle, new IO::Handle );
92 $writer->autoflush(1);# $error->autoflush(1);
93 my $pid = open3($writer, $reader, $error, @cmd );
96 my $errstr = join('', <$error>);
97 #chomp(my $errstr = <$error>);
98 $self->{errstr} = $errstr;
105 =item iscp SOURCE, DESTINATION
107 Can be called either as a subroutine or a method; however, the subroutine
108 interface is depriciated.
110 Prints the scp command to be execute, waits for the user to confirm, and
111 (optionally) executes scp, with the B<-p> and B<-r> flags.
113 Returns false and sets the B<errstr> attribute if there is an error.
120 $self->{'interact'} = 1;
128 print "Proceed [y/N]:";
129 my $x = scalar(<STDIN>);
143 =item new HOSTNAME [ USER ] | HASHREF
145 This is the constructor for a new Net::SCP object. You must specify a
146 hostname, and may optionally provide a user. Alternatively, you may pass a
147 hashref of named params, with the following keys:
152 cwd - current working directory on remote server
158 my $class = ref($proto) || $proto;
165 'user' => ( scalar(@_) ? shift : '' ),
170 bless($self, $class);
175 Compatibility method. Optionally sets the user.
180 my($self, $user) = @_;
181 $self->{'user'} = $user if $user;
186 Sets the cwd (used for a subsequent get or put request without a full pathname).
191 my($self, $cwd) = @_;
192 $self->{'cwd'} = $cwd || '/';
195 =item get REMOTE_FILE [, LOCAL_FILE]
197 Uses scp to transfer REMOTE_FILE from the remote host. If a local filename is
198 omitted, uses the basename of the remote file.
203 my($self, $remote, $local) = @_;
204 $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//;
205 $local ||= basename($remote);
206 my $source = $self->{'host'}. ":$remote";
207 $source = $self->{'user'}. '@'. $source if $self->{'user'};
208 $self->scp($source,$local);
211 =item mkdir DIRECTORY
213 Makes a directory on the remote server. Returns false and sets the B<errstr>
216 (Implementation note: An ssh connection is established to the remote machine
217 and '/bin/mkdir B<-p>' is used to create the directory.)
222 my($self, $directory) = @_;
223 $directory = $self->{'cwd'}. "/$directory"
224 if $self->{'cwd'} && $directory !~ /^\//;
225 my $host = $self->{'host'};
226 $host = $self->{'user'}. '@'. $host if $self->{'user'};
227 my($reader, $writer, $error ) =
228 ( new IO::Handle, new IO::Handle, new IO::Handle );
229 $writer->autoflush(1);
230 my $pid = sshopen3( $host, $writer, $reader, $error,
231 '/bin/mkdir', '-p ', shell_quote($directory) );
234 chomp(my $errstr = <$error>);
235 $self->{errstr} = $errstr || "mkdir exited with status ". $?>>8;
243 Returns the size in bytes for the given file as stored on the remote server.
244 Returns 0 on error, and sets the B<errstr> attribute. In the case of an actual
245 zero-length file on the remote server, the special value '0e0' is returned,
246 which evaluates to zero when used as a number, but is true.
248 (Implementation note: An ssh connection is established to the remote machine
249 and wc is used to determine the file size.)
254 my($self, $file) = @_;
255 $file = $self->{'cwd'}. "/$file" if $self->{'cwd'} && $file !~ /^\//;
256 my $host = $self->{'host'};
257 $host = $self->{'user'}. '@'. $host if $self->{'user'};
258 my($reader, $writer, $error ) =
259 ( new IO::Handle, new IO::Handle, new IO::Handle );
260 $writer->autoflush(1);
261 #sshopen2($host, $reader, $writer, 'wc', '-c ', shell_quote($file) );
263 sshopen3($host, $writer, $reader, $error, 'wc', '-c ', shell_quote($file) );
266 chomp(my $errstr = <$error>);
267 $self->{errstr} = $errstr || "wc exited with status ". $?>>8;
270 chomp( my $size = <$reader> || 0 );
271 if ( $size =~ /^\s*(\d+)/ ) {
274 $self->{errstr} = "unparsable output from remote wc: $size";
280 =item put LOCAL_FILE [, REMOTE_FILE]
282 Uses scp to trasnfer LOCAL_FILE to the remote host. If a remote filename is
283 omitted, uses the basename of the local file.
288 my($self, $local, $remote) = @_;
289 $remote ||= basename($local);
290 $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//;
291 my $dest = $self->{'host'}. ":$remote";
292 $dest = $self->{'user'}. '@'. $dest if $self->{'user'};
293 warn "scp $local $dest\n" if $DEBUG;
294 $self->scp($local, $dest);
299 Compatibility method: does nothing; returns true.
307 =head1 FREQUENTLY ASKED QUESTIONS
309 Q: How do you supply a password to connect with ssh within a perl script
310 using the Net::SSH module?
312 A: You don't. Use RSA or DSA keys. See the ssh-keygen(1) manpage.
314 Q: My script is "leaking" ssh processes.
316 A: See L<perlfaq8/"How do I avoid zombies on a Unix system">, L<IPC::Open2>,
317 L<IPC::Open3> and L<perlfunc/waitpid>.
321 Ivan Kohler <ivan-netscp_pod@420.am>
323 Major updates Anthony Deaver <bishop@projectmagnus.org>
325 Thanks to Jon Gunnip <jon@soundbite.com> for fixing a bug with size().
327 Patch for the mkdir method by Anthony Awtrey <tony@awtrey.com>
331 Copyright (c) 2000 Ivan Kohler.
332 Copyright (c) 2000 Silicon Interactive Software Design.
333 Copyright (c) 2000 Freeside Internet Services, LLC
335 This program is free software; you can redistribute it and/or modify it under
336 the same terms as Perl itself.
340 Still has no-OO cruft.
342 In order to work around some problems with commercial SSH2, if the source file
343 is on the local system, and is not a directory, the B<-r> flag is omitted.
345 It's probably better just to use SSH1 or OpenSSH <http://www.openssh.com/>
347 The Net::FTP-style OO stuff is kinda lame. And incomplete.