Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Net/SCP.pm |
Statements | Executed 33 statements in 1.14ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 542µs | 630µs | BEGIN@8 | Net::SCP::
1 | 1 | 1 | 21µs | 25µs | BEGIN@3 | Net::SCP::
1 | 1 | 1 | 12µs | 24µs | BEGIN@9 | Net::SCP::
1 | 1 | 1 | 11µs | 75µs | BEGIN@4 | Net::SCP::
1 | 1 | 1 | 11µs | 43µs | BEGIN@7 | Net::SCP::
1 | 1 | 1 | 8µs | 25µs | BEGIN@11 | Net::SCP::
1 | 1 | 1 | 8µs | 40µs | BEGIN@6 | Net::SCP::
1 | 1 | 1 | 7µs | 40µs | BEGIN@10 | Net::SCP::
1 | 1 | 1 | 6µs | 18µs | BEGIN@5 | Net::SCP::
0 | 0 | 0 | 0s | 0s | _islocal | Net::SCP::
0 | 0 | 0 | 0s | 0s | _yesno | Net::SCP::
0 | 0 | 0 | 0s | 0s | binary | Net::SCP::
0 | 0 | 0 | 0s | 0s | cwd | Net::SCP::
0 | 0 | 0 | 0s | 0s | get | Net::SCP::
0 | 0 | 0 | 0s | 0s | iscp | Net::SCP::
0 | 0 | 0 | 0s | 0s | login | Net::SCP::
0 | 0 | 0 | 0s | 0s | mkdir | Net::SCP::
0 | 0 | 0 | 0s | 0s | new | Net::SCP::
0 | 0 | 0 | 0s | 0s | put | Net::SCP::
0 | 0 | 0 | 0s | 0s | quit | Net::SCP::
0 | 0 | 0 | 0s | 0s | scp | Net::SCP::
0 | 0 | 0 | 0s | 0s | size | Net::SCP::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Net::SCP; | ||||
2 | |||||
3 | 3 | 24µs | 2 | 28µ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 # spent 25µs making 1 call to Net::SCP::BEGIN@3
# spent 4µs making 1 call to strict::import |
4 | 3 | 20µs | 2 | 139µ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 # spent 75µs making 1 call to Net::SCP::BEGIN@4
# spent 64µs making 1 call to vars::import |
5 | 3 | 16µs | 2 | 30µ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 # spent 18µs making 1 call to Net::SCP::BEGIN@5
# spent 12µs making 1 call to Exporter::import |
6 | 3 | 18µs | 2 | 73µ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 # spent 40µs making 1 call to Net::SCP::BEGIN@6
# spent 33µs making 1 call to Exporter::import |
7 | 3 | 21µs | 2 | 76µ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 # spent 43µs making 1 call to Net::SCP::BEGIN@7
# spent 33µs making 1 call to Exporter::import |
8 | 3 | 93µs | 2 | 664µ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 # spent 630µs making 1 call to Net::SCP::BEGIN@8
# spent 35µs making 1 call to Exporter::import |
9 | 3 | 25µs | 2 | 37µ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 # spent 24µs making 1 call to Net::SCP::BEGIN@9
# spent 12µs making 1 call to Exporter::import |
10 | 3 | 18µs | 2 | 73µ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 # spent 40µs making 1 call to Net::SCP::BEGIN@10
# spent 33µs making 1 call to Exporter::import |
11 | 3 | 894µs | 2 | 43µ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 # spent 25µs making 1 call to Net::SCP::BEGIN@11
# spent 17µs making 1 call to Exporter::import |
12 | |||||
13 | 1 | 6µs | @ISA = qw(Exporter); | ||
14 | 1 | 800ns | @EXPORT_OK = qw( scp iscp ); | ||
15 | 1 | 300ns | $VERSION = '0.08'; | ||
16 | |||||
17 | 1 | 200ns | $scp = "scp"; | ||
18 | |||||
19 | 1 | 300ns | $DEBUG = 0; | ||
20 | |||||
21 | =head1 NAME | ||||
22 | |||||
23 | Net::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 | |||||
52 | Simple wrappers around ssh and scp commands. | ||||
53 | |||||
54 | =head1 SUBROUTINES | ||||
55 | |||||
56 | =over 4 | ||||
57 | |||||
58 | =item scp SOURCE, DESTINATION | ||||
59 | |||||
60 | Can be called either as a subroutine or a method; however, the subroutine | ||||
61 | interface is depriciated. | ||||
62 | |||||
63 | Calls scp in batch mode, with the B<-B> B<-p> B<-q> and B<-r> options. | ||||
64 | Returns false upon error, with a text error message accessable in | ||||
65 | $scp->{errstr}. | ||||
66 | |||||
67 | Returns false and sets the B<errstr> attribute if there is an error. | ||||
68 | |||||
69 | =cut | ||||
70 | |||||
71 | sub 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 | |||||
107 | Can be called either as a subroutine or a method; however, the subroutine | ||||
108 | interface is depriciated. | ||||
109 | |||||
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. | ||||
112 | |||||
113 | Returns false and sets the B<errstr> attribute if there is an error. | ||||
114 | |||||
115 | =cut | ||||
116 | |||||
117 | sub iscp { | ||||
118 | if ( ref($_[0]) ) { | ||||
119 | my $self = shift; | ||||
120 | $self->{'interactive'} = 1; | ||||
121 | $self->scp(@_); | ||||
122 | } else { | ||||
123 | scp(@_, 1); | ||||
124 | } | ||||
125 | } | ||||
126 | |||||
127 | sub _yesno { | ||||
128 | print "Proceed [y/N]:"; | ||||
129 | my $x = scalar(<STDIN>); | ||||
130 | $x =~ /^y/i; | ||||
131 | } | ||||
132 | |||||
133 | sub _islocal { | ||||
134 | shift !~ /^[^:]+:/ | ||||
135 | } | ||||
136 | |||||
137 | =back | ||||
138 | |||||
139 | =head1 METHODS | ||||
140 | |||||
141 | =over 4 | ||||
142 | |||||
143 | =item new HOSTNAME [ USER ] | HASHREF | ||||
144 | |||||
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: | ||||
148 | |||||
149 | host - hostname | ||||
150 | user - username | ||||
151 | interactive - bool | ||||
152 | cwd - current working directory on remote server | ||||
153 | |||||
154 | =cut | ||||
155 | |||||
156 | sub 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 | |||||
175 | Compatibility method. Optionally sets the user. | ||||
176 | |||||
177 | =cut | ||||
178 | |||||
179 | sub login { | ||||
180 | my($self, $user) = @_; | ||||
181 | $self->{'user'} = $user if $user; | ||||
182 | } | ||||
183 | |||||
184 | =item cwd CWD | ||||
185 | |||||
186 | Sets the cwd (used for a subsequent get or put request without a full pathname). | ||||
187 | |||||
188 | =cut | ||||
189 | |||||
190 | sub cwd { | ||||
191 | my($self, $cwd) = @_; | ||||
192 | $self->{'cwd'} = $cwd || '/'; | ||||
193 | } | ||||
194 | |||||
195 | =item get REMOTE_FILE [, LOCAL_FILE] | ||||
196 | |||||
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. | ||||
199 | |||||
200 | =cut | ||||
201 | |||||
202 | sub 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 | |||||
213 | Makes a directory on the remote server. Returns false and sets the B<errstr> | ||||
214 | attribute on errors. | ||||
215 | |||||
216 | (Implementation note: An ssh connection is established to the remote machine | ||||
217 | and '/bin/mkdir B<-p>' is used to create the directory.) | ||||
218 | |||||
219 | =cut | ||||
220 | |||||
221 | sub 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 | |||||
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. | ||||
247 | |||||
248 | (Implementation note: An ssh connection is established to the remote machine | ||||
249 | and wc is used to determine the file size.) | ||||
250 | |||||
251 | =cut | ||||
252 | |||||
253 | sub 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 | |||||
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. | ||||
284 | |||||
285 | =cut | ||||
286 | |||||
287 | sub 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 | |||||
299 | Compatibility method: does nothing; returns true. | ||||
300 | |||||
301 | =cut | ||||
302 | |||||
303 | sub binary { 1; } | ||||
304 | |||||
305 | =item quit | ||||
306 | |||||
307 | Compatibility method: does nothing; returns true. | ||||
308 | |||||
309 | =cut | ||||
310 | |||||
311 | sub quit { 1; } | ||||
312 | |||||
313 | =back | ||||
314 | |||||
315 | =head1 FREQUENTLY ASKED QUESTIONS | ||||
316 | |||||
317 | Q: How do you supply a password to connect with ssh within a perl script | ||||
318 | using the Net::SSH module? | ||||
319 | |||||
320 | A: 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 | |||||
323 | A #2: See L<Net::SCP::Expect> instead. | ||||
324 | |||||
325 | Q: My script is "leaking" scp processes. | ||||
326 | |||||
327 | A: See L<perlfaq8/"How do I avoid zombies on a Unix system">, L<IPC::Open2>, | ||||
328 | L<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 | |||||
336 | Type: | ||||
337 | |||||
338 | ssh-keygen -t rsa | ||||
339 | |||||
340 | And do not enter a passphrase unless you wanted to be prompted for | ||||
341 | one during file copying. | ||||
342 | |||||
343 | Here 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 | |||||
360 | C<id_rsa.pub> is your public key. Copy it to C<~/.ssh> on target machine. | ||||
361 | |||||
362 | Put a copy of the public key file on each machine you want to log into. | ||||
363 | Name the copy C<authorized_keys> (some implementations name this file | ||||
364 | C<authorized_keys2>) | ||||
365 | |||||
366 | Then type: | ||||
367 | |||||
368 | chmod 600 authorized_keys | ||||
369 | |||||
370 | Then make sure your home dir on the remote machine is not group or | ||||
371 | world writeable. | ||||
372 | |||||
373 | =back | ||||
374 | |||||
375 | =head1 AUTHORS | ||||
376 | |||||
377 | Could really use a maintainer with enough time to at least review and apply | ||||
378 | patches more patches. Or the module should just be deprecated in favor of | ||||
379 | Net::SFTP::Expect or Net::SFTP::Foreign and made into a simple compatiblity | ||||
380 | wrapper. | ||||
381 | |||||
382 | Ivan Kohler <ivan-netscp_pod@420.am> | ||||
383 | |||||
384 | Major updates Anthony Deaver <bishop@projectmagnus.org> | ||||
385 | |||||
386 | Thanks to Jon Gunnip <jon@soundbite.com> for fixing a bug with size(). | ||||
387 | |||||
388 | Patch for the mkdir method by Anthony Awtrey <tony@awtrey.com>. | ||||
389 | |||||
390 | Thanks to terrence brannon <tbone@directsynergy.com> for the documentation in | ||||
391 | the GENERATING AND USING SSH KEYS section. | ||||
392 | |||||
393 | =head1 COPYRIGHT | ||||
394 | |||||
395 | Copyright (c) 2000 Ivan Kohler | ||||
396 | Copyright (c) 2007 Freeside Internet Services, Inc. | ||||
397 | All rights reserved. | ||||
398 | This program is free software; you can redistribute it and/or modify it under | ||||
399 | the same terms as Perl itself. | ||||
400 | |||||
401 | =head1 BUGS | ||||
402 | |||||
403 | Still has no-OO cruft. | ||||
404 | |||||
405 | In order to work around some problems with commercial SSH2, if the source file | ||||
406 | is on the local system, and is not a directory, the B<-r> flag is omitted. | ||||
407 | It's probably better just to use OpenSSH <http://www.openssh.com/> which is | ||||
408 | the de-facto standard these days anyway. | ||||
409 | |||||
410 | The Net::FTP-style OO stuff is kinda lame. And incomplete. | ||||
411 | |||||
412 | iscp doesnt expect you to be logging into the box that you are copying to | ||||
413 | for the first time. so it's completely clueless about how to handle the | ||||
414 | whole 'add this file to known hosts' message so it just hangs after the | ||||
415 | user hits y. (Thanks to John L. Utz III). To avoid this, SSH to the box | ||||
416 | once first. | ||||
417 | |||||
418 | =head1 SEE ALSO | ||||
419 | |||||
420 | For a perl implementation that does not require the system B<scp> command, see | ||||
421 | L<Net::SFTP> instead. | ||||
422 | |||||
423 | For a wrapper version that allows you to use passwords, see L<Net::SCP::Expect> | ||||
424 | instead. | ||||
425 | |||||
426 | For a wrapper version of the newer SFTP protocol, see L<Net::SFTP::Foreign> | ||||
427 | instead. | ||||
428 | |||||
429 | L<Net::SSH>, L<Net::SSH::Perl>, L<Net::SSH::Expect>, L<Net::SSH2>, | ||||
430 | L<IPC::PerlSSH> | ||||
431 | |||||
432 | scp(1), ssh(1), L<IO::File>, L<IPC::Open2>, L<IPC::Open3> | ||||
433 | |||||
434 | =cut | ||||
435 | |||||
436 | 1 | 4µs | 1; | ||
437 | |||||
438 |