From f43e25ef4731f835f859f16bcf08b833637eaeb4 Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 9 Oct 2000 16:29:08 +0000 Subject: [PATCH 1/1] initial import --- Changes | 5 ++ MANIFEST | 7 ++ MANIFEST.SKIP | 1 + Makefile.PL | 12 ++++ README | 35 +++++++++ SCP.pm | 228 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ test.pl | 20 ++++++ 7 files changed, 308 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 MANIFEST.SKIP create mode 100644 Makefile.PL create mode 100644 README create mode 100644 SCP.pm create mode 100644 test.pl diff --git a/Changes b/Changes new file mode 100644 index 0000000..319b5b5 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for Perl extension Net::SCP. + +0.01 Tue Aug 8 20:34:28 2000 + - original version; created by h2xs 1.19 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..91561c3 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,7 @@ +Changes +MANIFEST +MANIFEST.SKIP +Makefile.PL +SCP.pm +test.pl +README diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..ae335e7 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1 @@ +CVS/ diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..f6427e5 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,12 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + 'NAME' => 'Net::SCP', + 'VERSION_FROM' => 'SCP.pm', # finds $VERSION + 'PREREQ_PM' => { + 'Net::SSH' => 0, + 'String::ShellQuote' => 0, + 'IO::Handle' => 0 + }, +); diff --git a/README b/README new file mode 100644 index 0000000..3a4150a --- /dev/null +++ b/README @@ -0,0 +1,35 @@ +Net::SCP v0.01 + +Copyright (c) 2000 Ivan Kohler. +Copyright (c) 2000 Silicon Interactive Software Design. +Copyright (c) 2000 Freeside Internet Services, LLC +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +This module implements a Perl interface to scp. + +To install: + perl Makefile.PL + make + make test # nothing substantial yet + make install + +Documentation will then be available via `man Net:SCP' or `perldoc Net::SCP' + +Anonymous CVS access is available: + $ export CVSROOT=":pserver:anonymous@cleanwhisker.402.am:/home/cvs/cvsroot" + $ cvs login + (Logging in to anonymous@cleanwhisker.420.am) + CVS password: anonymous + $ cvs checkout Net-SCP +as well as . + +A mailing list for users and developers is available. Send a blank message to + to subscribe. + +Ivan Kohler +20 4,16 * * * saytime + +$Id: README,v 1.1 2000-10-09 16:29:08 ivan Exp $ + diff --git a/SCP.pm b/SCP.pm new file mode 100644 index 0000000..bbceed3 --- /dev/null +++ b/SCP.pm @@ -0,0 +1,228 @@ +package Net::SCP; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK $scp); +use Exporter; +use File::Basename; +use String::ShellQuote; +use IO::Handle; +use Net::SSH qw(sshopen3); + +@ISA = qw(Exporter); +@EXPORT_OK = qw( scp iscp ); +$VERSION = '0.01'; + +$scp = "scp"; + +=head1 NAME + +Net::SCP - Perl extension for secure copy protocol + +=head1 SYNOPSIS + + #procedural interface + use Net::SCP qw(scp iscp); + scp($source, $destination); + iscp($source, $destination); #shows command, asks for confirmation, and + #allows user to type a password on tty + + #Net::FTP-style + $scp = Net::SCP->new("hostname"); + $scp->login("user"); + $scp->cwd("/dir"); + $scp->size("file"); + $scp->get("file"); + $scp->quit; + +=head1 DESCRIPTION + +Simple wrappers around ssh and scp commands. + +=head1 SUBROUTINES + +=over 4 + +=item scp SOURCE, DESTINATION + +Calls scp in batch mode, with the B<-B> B<-p> B<-q> and B<-r> options. + +=cut + +sub scp { + my($src, $dest) = @_; + my $flags = '-Bpq'; + $flags .= 'r' unless &_islocal($src) && ! -d $src; + my @cmd = ( $scp, $flags, $src, $dest ); + system(@cmd); +} + +=item iscp SOURCE, DESTINATION + +Prints the scp command to be execute, waits for the user to confirm, and +(optionally) executes scp, with the B<-p> and B<-r> flags. + +=cut + +sub iscp { + my($src, $dest) = @_; + my $flags = '-p'; + $flags .= 'r' unless &_islocal($src) && ! -d $src; + my @cmd = ( $scp, $flags, $src, $dest ); + print join(' ', @cmd), "\n"; + if ( &_yesno ) { + system(@cmd); + } +} + +sub _yesno { + print "Proceed [y/N]:"; + my $x = scalar(); + $x =~ /^y/i; +} + +sub _islocal { + shift !~ /^[^:]+:/ +} + +=back + +=head1 METHODS + +=over 4 + +=item new HOSTNAME + +This is the constructor for a new Net::SCP object. Additional parameters +are ignored. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { + 'host' => shift, + 'user' => '', + 'cwd' => '', + }; + bless($self, $class); +} + +=item login [USER] + +Compatibility method. Optionally sets the user. + +=cut + +sub login { + my($self, $user) = @_; + $self->{'user'} = $user; +} + +=item cwd CWD + +Sets the cwd (used for a subsequent get or put request without a full pathname). + +=cut + +sub cwd { + my($self, $cwd) = @_; + $self->{'cwd'} = $cwd || '/'; +} + +=item get REMOTE_FILE [, LOCAL_FILE] + +Uses scp to transfer REMOTE_FILE from the remote host. If a local filename is +omitted, uses the basename of the remote file. + +=cut + +sub get { + my($self, $remote, $local) = @_; + $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//; + $local ||= basename($remote); + my $source = $self->{'host'}. ":$remote"; + $source = $self->{'user'}. '@'. $source if $self->{'user'}; + scp($source,$local); +} + +=item size FILE + +Returns the size in bytes for the given file as stored on the remote server. + +(Implementation note: An ssh connection is established to the remote machine +and wc is used to determine the file size. No distinction is currently made +between nonexistant and zero-length files.) + +=cut + +sub size { + my($self, $file) = @_; + $file = $self->{'cwd'}. "/$file" if $self->{'cwd'} && $file !~ /^\//; + my $host = $self->{'host'}; + $host = $self->{'user'}. '@'. $host if $self->{'user'}; + my($reader, $writer, $error ) = + ( new IO::Handle, new IO::Handle, new IO::Handle ); + $writer->autoflush(1);# $error->autoflush(1); + #sshopen2($host, $reader, $writer, 'wc', '-c ', shell_quote($file) ); + sshopen3($host, $writer, $reader, $error, 'wc', '-c ', shell_quote($file) ); + chomp( my $size = <$reader> || 0 ); + if ( $size =~ /^\s+(\d+)/ ) { + $1; + } else { + warn "unparsable output from remote wc"; + 0; + } +} + +=item put LOCAL_FILE [, REMOTE_FILE] + +Uses scp to trasnfer LOCAL_FILE to the remote host. If a remote filename is +omitted, uses the basename of the local file. + +=cut + +sub put { + my($self, $local, $remote) = @_; + $remote ||= basename($local); + $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//; + my $dest = $self->{'host'}. ":$remote"; + $dest = $self->{'user'}. '@'. $dest if $self->{'user'}; + warn "scp $local $dest\n"; + scp($local, $dest); +} + +=item binary + +Compatibility method: does nothing; returns true. + +=cut + +sub binary { 1; } + +=back + +=head1 AUTHOR + +Ivan Kohler + +=head1 BUGS + +Not OO. + +In order to work around some problems with commercial SSH2, if the source file +is on the local system, and is not a directory, the B<-r> flag is omitted. + +It's probably better just to use SSH1 or OpenSSH + +The Net::FTP-style OO stuff is kinda lame. And incomplete. + +=head1 SEE ALSO + +scp(1), ssh(1) + +=cut + +1; + + diff --git a/test.pl b/test.pl new file mode 100644 index 0000000..a955c04 --- /dev/null +++ b/test.pl @@ -0,0 +1,20 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +######################### We start with some black magic to print on failure. + +# Change 1..1 below to 1..last_test_to_print . +# (It may become useful if the test is moved to ./t subdirectory.) + +BEGIN { $| = 1; print "1..1\n"; } +END {print "not ok 1\n" unless $loaded;} +use Net::SCP; +$loaded = 1; +print "ok 1\n"; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): + -- 2.11.0