← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:51 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Net/SCP.pm
StatementsExecuted 33 statements in 1.14ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111542µs630µsNet::SCP::::BEGIN@8Net::SCP::BEGIN@8
11121µs25µsNet::SCP::::BEGIN@3Net::SCP::BEGIN@3
11112µs24µsNet::SCP::::BEGIN@9Net::SCP::BEGIN@9
11111µs75µsNet::SCP::::BEGIN@4Net::SCP::BEGIN@4
11111µs43µsNet::SCP::::BEGIN@7Net::SCP::BEGIN@7
1118µs25µsNet::SCP::::BEGIN@11Net::SCP::BEGIN@11
1118µs40µsNet::SCP::::BEGIN@6Net::SCP::BEGIN@6
1117µs40µsNet::SCP::::BEGIN@10Net::SCP::BEGIN@10
1116µs18µsNet::SCP::::BEGIN@5Net::SCP::BEGIN@5
0000s0sNet::SCP::::_islocalNet::SCP::_islocal
0000s0sNet::SCP::::_yesnoNet::SCP::_yesno
0000s0sNet::SCP::::binaryNet::SCP::binary
0000s0sNet::SCP::::cwdNet::SCP::cwd
0000s0sNet::SCP::::getNet::SCP::get
0000s0sNet::SCP::::iscpNet::SCP::iscp
0000s0sNet::SCP::::loginNet::SCP::login
0000s0sNet::SCP::::mkdirNet::SCP::mkdir
0000s0sNet::SCP::::newNet::SCP::new
0000s0sNet::SCP::::putNet::SCP::put
0000s0sNet::SCP::::quitNet::SCP::quit
0000s0sNet::SCP::::scpNet::SCP::scp
0000s0sNet::SCP::::sizeNet::SCP::size
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Net::SCP;
2
3324µs228µs
# spent 25µs (21+4) within Net::SCP::BEGIN@3 which was called: # once (21µs+4µs) by Tapper::MCP::Net::BEGIN@12 at line 3
use strict;
# spent 25µs making 1 call to Net::SCP::BEGIN@3 # spent 4µs making 1 call to strict::import
4320µs2139µs
# spent 75µs (11+64) within Net::SCP::BEGIN@4 which was called: # once (11µs+64µs) by Tapper::MCP::Net::BEGIN@12 at line 4
use vars qw($VERSION @ISA @EXPORT_OK $scp $DEBUG);
# spent 75µs making 1 call to Net::SCP::BEGIN@4 # spent 64µs making 1 call to vars::import
5316µs230µs
# spent 18µs (6+12) within Net::SCP::BEGIN@5 which was called: # once (6µs+12µs) by Tapper::MCP::Net::BEGIN@12 at line 5
use Exporter;
# spent 18µs making 1 call to Net::SCP::BEGIN@5 # spent 12µs making 1 call to Exporter::import
6318µs273µs
# spent 40µs (8+33) within Net::SCP::BEGIN@6 which was called: # once (8µs+33µs) by Tapper::MCP::Net::BEGIN@12 at line 6
use Carp;
# spent 40µs making 1 call to Net::SCP::BEGIN@6 # spent 33µs making 1 call to Exporter::import
7321µs276µs
# spent 43µs (11+32) within Net::SCP::BEGIN@7 which was called: # once (11µs+32µs) by Tapper::MCP::Net::BEGIN@12 at line 7
use File::Basename;
# spent 43µs making 1 call to Net::SCP::BEGIN@7 # spent 33µs making 1 call to Exporter::import
8393µs2664µs
# spent 630µs (542+87) within Net::SCP::BEGIN@8 which was called: # once (542µs+87µs) by Tapper::MCP::Net::BEGIN@12 at line 8
use String::ShellQuote;
# spent 630µs making 1 call to Net::SCP::BEGIN@8 # spent 35µs making 1 call to Exporter::import
9325µs237µs
# spent 24µs (12+12) within Net::SCP::BEGIN@9 which was called: # once (12µs+12µs) by Tapper::MCP::Net::BEGIN@12 at line 9
use IO::Handle;
# spent 24µs making 1 call to Net::SCP::BEGIN@9 # spent 12µs making 1 call to Exporter::import
10318µs273µs
# spent 40µs (7+33) within Net::SCP::BEGIN@10 which was called: # once (7µs+33µs) by Tapper::MCP::Net::BEGIN@12 at line 10
use Net::SSH qw(sshopen3);
# spent 40µs making 1 call to Net::SCP::BEGIN@10 # spent 33µs making 1 call to Exporter::import
113894µs243µs
# spent 25µs (8+17) within Net::SCP::BEGIN@11 which was called: # once (8µs+17µs) by Tapper::MCP::Net::BEGIN@12 at line 11
use IPC::Open3;
# spent 25µs making 1 call to Net::SCP::BEGIN@11 # spent 17µs making 1 call to Exporter::import
12
1316µs@ISA = qw(Exporter);
141800ns@EXPORT_OK = qw( scp iscp );
151300ns$VERSION = '0.08';
16
171200ns$scp = "scp";
18
191300ns$DEBUG = 0;
20
21=head1 NAME
22
23Net::SCP - Perl extension for secure copy protocol
24
25=head1 SYNOPSIS
26
27 #procedural interface
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
32
33 #OO interface
34 $scp = Net::SCP->new( "hostname", "username" );
35 #with named params
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};
39 #tmtowtdi
40 $scp = new Net::SCP;
41 $scp->scp($source, $destination);
42
43 #Net::FTP-style
44 $scp = Net::SCP->new("hostname");
45 $scp->login("user");
46 $scp->cwd("/dir");
47 $scp->size("file");
48 $scp->get("file");
49
50=head1 DESCRIPTION
51
52Simple wrappers around ssh and scp commands.
53
54=head1 SUBROUTINES
55
56=over 4
57
58=item scp SOURCE, DESTINATION
59
60Can be called either as a subroutine or a method; however, the subroutine
61interface is depriciated.
62
63Calls scp in batch mode, with the B<-B> B<-p> B<-q> and B<-r> options.
64Returns false upon error, with a text error message accessable in
65$scp->{errstr}.
66
67Returns false and sets the B<errstr> attribute if there is an error.
68
69=cut
70
71sub scp {
72 my $self = ref($_[0]) ? shift : {};
73 my($src, $dest, $interact) = @_;
74 my $flags = '-p';
75 $flags .= 'r' unless &_islocal($src) && ! -d $src;
76 my @cmd;
77 if ( ( defined($interact) && $interact )
78 || ( defined($self->{interactive}) && $self->{interactive} ) ) {
79 @cmd = ( $scp, $flags, $src, $dest );
80 print join(' ', @cmd), "\n";
81 unless ( &_yesno ) {
82 $self->{errstr} = "User declined";
83 return 0;
84 }
85 } else {
86 $flags .= 'qB';
87 @cmd = ( $scp, $flags, $src, $dest );
88 }
89 my($reader, $writer, $error ) =
90 ( new IO::Handle, new IO::Handle, new IO::Handle );
91 $writer->autoflush(1);# $error->autoflush(1);
92 local $SIG{CHLD} = 'DEFAULT';
93 my $pid = open3($writer, $reader, $error, @cmd );
94 waitpid $pid, 0;
95 if ( $? >> 8 ) {
96 my $errstr = join('', <$error>);
97 #chomp(my $errstr = <$error>);
98 $self->{errstr} = $errstr;
99 0;
100 } else {
101 1;
102 }
103}
104
105=item iscp SOURCE, DESTINATION
106
107Can be called either as a subroutine or a method; however, the subroutine
108interface is depriciated.
109
110Prints 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.
112
113Returns false and sets the B<errstr> attribute if there is an error.
114
115=cut
116
117sub iscp {
118 if ( ref($_[0]) ) {
119 my $self = shift;
120 $self->{'interactive'} = 1;
121 $self->scp(@_);
122 } else {
123 scp(@_, 1);
124 }
125}
126
127sub _yesno {
128 print "Proceed [y/N]:";
129 my $x = scalar(<STDIN>);
130 $x =~ /^y/i;
131}
132
133sub _islocal {
134 shift !~ /^[^:]+:/
135}
136
137=back
138
139=head1 METHODS
140
141=over 4
142
143=item new HOSTNAME [ USER ] | HASHREF
144
145This is the constructor for a new Net::SCP object. You must specify a
146hostname, and may optionally provide a user. Alternatively, you may pass a
147hashref of named params, with the following keys:
148
149 host - hostname
150 user - username
151 interactive - bool
152 cwd - current working directory on remote server
153
154=cut
155
156sub new {
157 my $proto = shift;
158 my $class = ref($proto) || $proto;
159 my $self;
160 if ( ref($_[0]) ) {
161 $self = shift;
162 } else {
163 $self = {
164 'host' => shift,
165 'user' => ( scalar(@_) ? shift : '' ),
166 'interactive' => 0,
167 'cwd' => '',
168 };
169 }
170 bless($self, $class);
171}
172
173=item login [USER]
174
175Compatibility method. Optionally sets the user.
176
177=cut
178
179sub login {
180 my($self, $user) = @_;
181 $self->{'user'} = $user if $user;
182}
183
184=item cwd CWD
185
186Sets the cwd (used for a subsequent get or put request without a full pathname).
187
188=cut
189
190sub cwd {
191 my($self, $cwd) = @_;
192 $self->{'cwd'} = $cwd || '/';
193}
194
195=item get REMOTE_FILE [, LOCAL_FILE]
196
197Uses scp to transfer REMOTE_FILE from the remote host. If a local filename is
198omitted, uses the basename of the remote file.
199
200=cut
201
202sub get {
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);
209}
210
211=item mkdir DIRECTORY
212
213Makes a directory on the remote server. Returns false and sets the B<errstr>
214attribute on errors.
215
216(Implementation note: An ssh connection is established to the remote machine
217and '/bin/mkdir B<-p>' is used to create the directory.)
218
219=cut
220
221sub mkdir {
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) );
232 waitpid $pid, 0;
233 if ( $? >> 8 ) {
234 chomp(my $errstr = <$error> || '');
235 $self->{errstr} = $errstr || "mkdir exited with status ". ($?>>8);
236 return 0;
237 }
238 1;
239}
240
241=item size FILE
242
243Returns the size in bytes for the given file as stored on the remote server.
244Returns 0 on error, and sets the B<errstr> attribute. In the case of an actual
245zero-length file on the remote server, the special value '0e0' is returned,
246which evaluates to zero when used as a number, but is true.
247
248(Implementation note: An ssh connection is established to the remote machine
249and wc is used to determine the file size.)
250
251=cut
252
253sub 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) );
262 my $pid =
263 sshopen3($host, $writer, $reader, $error, 'wc', '-c ', shell_quote($file) );
264 waitpid $pid, 0;
265 if ( $? >> 8 ) {
266 chomp(my $errstr = <$error>);
267 $self->{errstr} = $errstr || "wc exited with status ". $?>>8;
268 0;
269 } else {
270 chomp( my $size = <$reader> || 0 );
271 if ( $size =~ /^\s*(\d+)/ ) {
272 $1 ? $1 : '0e0';
273 } else {
274 $self->{errstr} = "unparsable output from remote wc: $size";
275 0;
276 }
277 }
278}
279
280=item put LOCAL_FILE [, REMOTE_FILE]
281
282Uses scp to trasnfer LOCAL_FILE to the remote host. If a remote filename is
283omitted, uses the basename of the local file.
284
285=cut
286
287sub put {
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);
295}
296
297=item binary
298
299Compatibility method: does nothing; returns true.
300
301=cut
302
303sub binary { 1; }
304
305=item quit
306
307Compatibility method: does nothing; returns true.
308
309=cut
310
311sub quit { 1; }
312
313=back
314
315=head1 FREQUENTLY ASKED QUESTIONS
316
317Q: How do you supply a password to connect with ssh within a perl script
318using the Net::SSH module?
319
320A: You don't (at least not with this module). Use RSA or DSA keys. See the
321 quick help in the next section and the ssh-keygen(1) manpage.
322
323A #2: See L<Net::SCP::Expect> instead.
324
325Q: My script is "leaking" scp processes.
326
327A: See L<perlfaq8/"How do I avoid zombies on a Unix system">, L<IPC::Open2>,
328L<IPC::Open3> and L<perlfunc/waitpid>.
329
330=head1 GENERATING AND USING SSH KEYS
331
332=over 4
333
334=item 1 Generate keys
335
336Type:
337
338 ssh-keygen -t rsa
339
340And do not enter a passphrase unless you wanted to be prompted for
341one during file copying.
342
343Here is what you will see:
344
345 $ ssh-keygen -t rsa
346 Generating public/private rsa key pair.
347 Enter file in which to save the key (/home/User/.ssh/id_rsa):
348 Enter passphrase (empty for no passphrase):
349
350 Enter same passphrase again:
351
352 Your identification has been saved in /home/User/.ssh/id_rsa.
353 Your public key has been saved in /home/User/.ssh/id_rsa.pub.
354 The key fingerprint is:
355 5a:cd:2b:0a:cd:d9:15:85:26:79:40:0c:55:2a:f4:23 User@JEFF-CPU
356
357
358=item 2 Copy public to machines you want to upload to
359
360C<id_rsa.pub> is your public key. Copy it to C<~/.ssh> on target machine.
361
362Put a copy of the public key file on each machine you want to log into.
363Name the copy C<authorized_keys> (some implementations name this file
364C<authorized_keys2>)
365
366Then type:
367
368 chmod 600 authorized_keys
369
370Then make sure your home dir on the remote machine is not group or
371world writeable.
372
373=back
374
375=head1 AUTHORS
376
377Could really use a maintainer with enough time to at least review and apply
378patches more patches. Or the module should just be deprecated in favor of
379Net::SFTP::Expect or Net::SFTP::Foreign and made into a simple compatiblity
380wrapper.
381
382Ivan Kohler <ivan-netscp_pod@420.am>
383
384Major updates Anthony Deaver <bishop@projectmagnus.org>
385
386Thanks to Jon Gunnip <jon@soundbite.com> for fixing a bug with size().
387
388Patch for the mkdir method by Anthony Awtrey <tony@awtrey.com>.
389
390Thanks to terrence brannon <tbone@directsynergy.com> for the documentation in
391the GENERATING AND USING SSH KEYS section.
392
393=head1 COPYRIGHT
394
395Copyright (c) 2000 Ivan Kohler
396Copyright (c) 2007 Freeside Internet Services, Inc.
397All rights reserved.
398This program is free software; you can redistribute it and/or modify it under
399the same terms as Perl itself.
400
401=head1 BUGS
402
403Still has no-OO cruft.
404
405In order to work around some problems with commercial SSH2, if the source file
406is on the local system, and is not a directory, the B<-r> flag is omitted.
407It's probably better just to use OpenSSH <http://www.openssh.com/> which is
408the de-facto standard these days anyway.
409
410The Net::FTP-style OO stuff is kinda lame. And incomplete.
411
412iscp doesnt expect you to be logging into the box that you are copying to
413for the first time. so it's completely clueless about how to handle the
414whole 'add this file to known hosts' message so it just hangs after the
415user hits y. (Thanks to John L. Utz III). To avoid this, SSH to the box
416once first.
417
418=head1 SEE ALSO
419
420For a perl implementation that does not require the system B<scp> command, see
421L<Net::SFTP> instead.
422
423For a wrapper version that allows you to use passwords, see L<Net::SCP::Expect>
424instead.
425
426For a wrapper version of the newer SFTP protocol, see L<Net::SFTP::Foreign>
427instead.
428
429L<Net::SSH>, L<Net::SSH::Perl>, L<Net::SSH::Expect>, L<Net::SSH2>,
430L<IPC::PerlSSH>
431
432scp(1), ssh(1), L<IO::File>, L<IPC::Open2>, L<IPC::Open3>
433
434=cut
435
43614µs1;
437
438