This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Synch with CPAN distribution libnet-3.12
[perl5.git] / cpan / libnet / lib / Net / Cmd.pm
1 # Net::Cmd.pm
2 #
3 # Copyright (C) 1995-2006 Graham Barr.  All rights reserved.
4 # Copyright (C) 2013-2016, 2020 Steve Hay.  All rights reserved.
5 # This module is free software; you can redistribute it and/or modify it under
6 # the same terms as Perl itself, i.e. under the terms of either the GNU General
7 # Public License or the Artistic License, as specified in the F<LICENCE> file.
8
9 package Net::Cmd;
10
11 use 5.008001;
12
13 use strict;
14 use warnings;
15
16 use Carp;
17 use Exporter;
18 use Symbol 'gensym';
19 use Errno 'EINTR';
20
21 BEGIN {
22   if ($^O eq 'os390') {
23     require Convert::EBCDIC;
24
25     #    Convert::EBCDIC->import;
26   }
27 }
28
29 our $VERSION = "3.12";
30 our @ISA     = qw(Exporter);
31 our @EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
32
33 use constant CMD_INFO    => 1;
34 use constant CMD_OK      => 2;
35 use constant CMD_MORE    => 3;
36 use constant CMD_REJECT  => 4;
37 use constant CMD_ERROR   => 5;
38 use constant CMD_PENDING => 0;
39
40 use constant DEF_REPLY_CODE => 421;
41
42 my %debug = ();
43
44 my $tr = $^O eq 'os390' ? Convert::EBCDIC->new() : undef;
45
46 sub toebcdic {
47   my $cmd = shift;
48
49   unless (exists ${*$cmd}{'net_cmd_asciipeer'}) {
50     my $string    = $_[0];
51     my $ebcdicstr = $tr->toebcdic($string);
52     ${*$cmd}{'net_cmd_asciipeer'} = $string !~ /^\d+/ && $ebcdicstr =~ /^\d+/;
53   }
54
55   ${*$cmd}{'net_cmd_asciipeer'}
56     ? $tr->toebcdic($_[0])
57     : $_[0];
58 }
59
60
61 sub toascii {
62   my $cmd = shift;
63   ${*$cmd}{'net_cmd_asciipeer'}
64     ? $tr->toascii($_[0])
65     : $_[0];
66 }
67
68
69 sub _print_isa {
70   no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict)
71
72   my $pkg = shift;
73   my $cmd = $pkg;
74
75   $debug{$pkg} ||= 0;
76
77   my %done = ();
78   my @do   = ($pkg);
79   my %spc  = ($pkg, "");
80
81   while ($pkg = shift @do) {
82     next if defined $done{$pkg};
83
84     $done{$pkg} = 1;
85
86     my $v =
87       defined ${"${pkg}::VERSION"}
88       ? "(" . ${"${pkg}::VERSION"} . ")"
89       : "";
90
91     my $spc = $spc{$pkg};
92     $cmd->debug_print(1, "${spc}${pkg}${v}\n");
93
94     if (@{"${pkg}::ISA"}) {
95       @spc{@{"${pkg}::ISA"}} = ("  " . $spc{$pkg}) x @{"${pkg}::ISA"};
96       unshift(@do, @{"${pkg}::ISA"});
97     }
98   }
99 }
100
101
102 sub debug {
103   @_ == 1 or @_ == 2 or croak 'usage: $obj->debug([$level])';
104
105   my ($cmd, $level) = @_;
106   my $pkg    = ref($cmd) || $cmd;
107   my $oldval = 0;
108
109   if (ref($cmd)) {
110     $oldval = ${*$cmd}{'net_cmd_debug'} || 0;
111   }
112   else {
113     $oldval = $debug{$pkg} || 0;
114   }
115
116   return $oldval
117     unless @_ == 2;
118
119   $level = $debug{$pkg} || 0
120     unless defined $level;
121
122   _print_isa($pkg)
123     if ($level && !exists $debug{$pkg});
124
125   if (ref($cmd)) {
126     ${*$cmd}{'net_cmd_debug'} = $level;
127   }
128   else {
129     $debug{$pkg} = $level;
130   }
131
132   $oldval;
133 }
134
135
136 sub message {
137   @_ == 1 or croak 'usage: $obj->message()';
138
139   my $cmd = shift;
140
141   wantarray
142     ? @{${*$cmd}{'net_cmd_resp'}}
143     : join("", @{${*$cmd}{'net_cmd_resp'}});
144 }
145
146
147 sub debug_text { $_[2] }
148
149
150 sub debug_print {
151   my ($cmd, $out, $text) = @_;
152   print STDERR $cmd, ($out ? '>>> ' : '<<< '), $cmd->debug_text($out, $text);
153 }
154
155
156 sub code {
157   @_ == 1 or croak 'usage: $obj->code()';
158
159   my $cmd = shift;
160
161   ${*$cmd}{'net_cmd_code'} = $cmd->DEF_REPLY_CODE
162     unless exists ${*$cmd}{'net_cmd_code'};
163
164   ${*$cmd}{'net_cmd_code'};
165 }
166
167
168 sub status {
169   @_ == 1 or croak 'usage: $obj->status()';
170
171   my $cmd = shift;
172
173   substr(${*$cmd}{'net_cmd_code'}, 0, 1);
174 }
175
176
177 sub set_status {
178   @_ == 3 or croak 'usage: $obj->set_status($code, $resp)';
179
180   my $cmd = shift;
181   my ($code, $resp) = @_;
182
183   $resp = defined $resp ? [$resp] : []
184     unless ref($resp);
185
186   (${*$cmd}{'net_cmd_code'}, ${*$cmd}{'net_cmd_resp'}) = ($code, $resp);
187
188   1;
189 }
190
191 sub _syswrite_with_timeout {
192   my $cmd = shift;
193   my $line = shift;
194
195   my $len    = length($line);
196   my $offset = 0;
197   my $win    = "";
198   vec($win, fileno($cmd), 1) = 1;
199   my $timeout = $cmd->timeout || undef;
200   my $initial = time;
201   my $pending = $timeout;
202
203   local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
204
205   while ($len) {
206     my $wout;
207     my $nfound = select(undef, $wout = $win, undef, $pending);
208     if ((defined $nfound and $nfound > 0) or -f $cmd)    # -f for testing on win32
209     {
210       my $w = syswrite($cmd, $line, $len, $offset);
211       if (! defined($w) ) {
212         my $err = $!;
213         $cmd->close;
214         $cmd->_set_status_closed($err);
215         return;
216       }
217       $len -= $w;
218       $offset += $w;
219     }
220     elsif ($nfound == -1) {
221       if ( $! == EINTR ) {
222         if ( defined($timeout) ) {
223           redo if ($pending = $timeout - ( time - $initial ) ) > 0;
224           $cmd->_set_status_timeout;
225           return;
226         }
227         redo;
228       }
229       my $err = $!;
230       $cmd->close;
231       $cmd->_set_status_closed($err);
232       return;
233     }
234     else {
235       $cmd->_set_status_timeout;
236       return;
237     }
238   }
239
240   return 1;
241 }
242
243 sub _set_status_timeout {
244   my $cmd = shift;
245   my $pkg = ref($cmd) || $cmd;
246
247   $cmd->set_status($cmd->DEF_REPLY_CODE, "[$pkg] Timeout");
248   carp(ref($cmd) . ": " . (caller(1))[3] . "(): timeout") if $cmd->debug;
249 }
250
251 sub _set_status_closed {
252   my $cmd = shift;
253   my $err = shift;
254   my $pkg = ref($cmd) || $cmd;
255
256   $cmd->set_status($cmd->DEF_REPLY_CODE, "[$pkg] Connection closed");
257   carp(ref($cmd) . ": " . (caller(1))[3]
258     . "(): unexpected EOF on command channel: $err") if $cmd->debug;
259 }
260
261 sub _is_closed {
262   my $cmd = shift;
263   if (!defined fileno($cmd)) {
264      $cmd->_set_status_closed($!);
265      return 1;
266   }
267   return 0;
268 }
269
270 sub command {
271   my $cmd = shift;
272
273   return $cmd
274     if $cmd->_is_closed;
275
276   $cmd->dataend()
277     if (exists ${*$cmd}{'net_cmd_last_ch'});
278
279   if (scalar(@_)) {
280     my $str = join(
281       " ",
282       map {
283         /\n/
284           ? do { my $n = $_; $n =~ tr/\n/ /; $n }
285           : $_;
286         } @_
287     );
288     $str = $cmd->toascii($str) if $tr;
289     $str .= "\015\012";
290
291     $cmd->debug_print(1, $str)
292       if ($cmd->debug);
293
294     # though documented to return undef on failure, the legacy behavior
295     # was to return $cmd even on failure, so this odd construct does that
296     $cmd->_syswrite_with_timeout($str)
297       or return $cmd;
298   }
299
300   $cmd;
301 }
302
303
304 sub ok {
305   @_ == 1 or croak 'usage: $obj->ok()';
306
307   my $code = $_[0]->code;
308   0 < $code && $code < 400;
309 }
310
311
312 sub unsupported {
313   my $cmd = shift;
314
315   $cmd->set_status(580, 'Unsupported command');
316
317   0;
318 }
319
320
321 sub getline {
322   my $cmd = shift;
323
324   ${*$cmd}{'net_cmd_lines'} ||= [];
325
326   return shift @{${*$cmd}{'net_cmd_lines'}}
327     if scalar(@{${*$cmd}{'net_cmd_lines'}});
328
329   my $partial = defined(${*$cmd}{'net_cmd_partial'}) ? ${*$cmd}{'net_cmd_partial'} : "";
330
331   return
332     if $cmd->_is_closed;
333
334   my $fd = fileno($cmd);
335   my $rin = "";
336   vec($rin, $fd, 1) = 1;
337
338   my $timeout = $cmd->timeout || undef;
339   my $initial = time;
340   my $pending = $timeout;
341
342   my $buf;
343
344   until (scalar(@{${*$cmd}{'net_cmd_lines'}})) {
345     my $rout;
346
347     my $select_ret = select($rout = $rin, undef, undef, $pending);
348     if (defined $select_ret and $select_ret > 0) {
349       my $r = sysread($cmd, $buf = "", 1024);
350       if (! defined($r) ) {
351         my $err = $!;
352         $cmd->close;
353         $cmd->_set_status_closed($err);
354         return;
355       }
356
357       substr($buf, 0, 0) = $partial;    ## prepend from last sysread
358
359       my @buf = split(/\015?\012/, $buf, -1);    ## break into lines
360
361       $partial = pop @buf;
362
363       push(@{${*$cmd}{'net_cmd_lines'}}, map {"$_\n"} @buf);
364
365     }
366     elsif (defined $select_ret && $select_ret == -1) {
367       if ( $! == EINTR ) {
368         if ( defined($timeout) ) {
369           redo if ($pending = $timeout - ( time - $initial ) ) > 0;
370           $cmd->_set_status_timeout;
371           return;
372         }
373         redo;
374       }
375       my $err = $!;
376       $cmd->close;
377       $cmd->_set_status_closed($err);
378       return;
379     }
380     else {
381       $cmd->_set_status_timeout;
382       return;
383     }
384   }
385
386   ${*$cmd}{'net_cmd_partial'} = $partial;
387
388   if ($tr) {
389     foreach my $ln (@{${*$cmd}{'net_cmd_lines'}}) {
390       $ln = $cmd->toebcdic($ln);
391     }
392   }
393
394   shift @{${*$cmd}{'net_cmd_lines'}};
395 }
396
397
398 sub ungetline {
399   my ($cmd, $str) = @_;
400
401   ${*$cmd}{'net_cmd_lines'} ||= [];
402   unshift(@{${*$cmd}{'net_cmd_lines'}}, $str);
403 }
404
405
406 sub parse_response {
407   return ()
408     unless $_[1] =~ s/^(\d\d\d)(.?)//o;
409   ($1, $2 eq "-");
410 }
411
412
413 sub response {
414   my $cmd = shift;
415   my ($code, $more) = (undef) x 2;
416
417   $cmd->set_status($cmd->DEF_REPLY_CODE, undef); # initialize the response
418
419   while (1) {
420     my $str = $cmd->getline();
421
422     return CMD_ERROR
423       unless defined($str);
424
425     $cmd->debug_print(0, $str)
426       if ($cmd->debug);
427
428     ($code, $more) = $cmd->parse_response($str);
429     unless (defined $code) {
430       carp("$cmd: response(): parse error in '$str'") if ($cmd->debug);
431       $cmd->ungetline($str);
432       $@ = $str;   # $@ used as tunneling hack
433       return CMD_ERROR;
434     }
435
436     ${*$cmd}{'net_cmd_code'} = $code;
437
438     push(@{${*$cmd}{'net_cmd_resp'}}, $str);
439
440     last unless ($more);
441   }
442
443   return unless defined $code;
444   substr($code, 0, 1);
445 }
446
447
448 sub read_until_dot {
449   my $cmd = shift;
450   my $fh  = shift;
451   my $arr = [];
452
453   while (1) {
454     my $str = $cmd->getline() or return;
455
456     $cmd->debug_print(0, $str)
457       if ($cmd->debug & 4);
458
459     last if ($str =~ /^\.\r?\n/o);
460
461     $str =~ s/^\.\././o;
462
463     if (defined $fh) {
464       print $fh $str;
465     }
466     else {
467       push(@$arr, $str);
468     }
469   }
470
471   $arr;
472 }
473
474
475 sub datasend {
476   my $cmd  = shift;
477   my $arr  = @_ == 1 && ref($_[0]) ? $_[0] : \@_;
478   my $line = join("", @$arr);
479
480   # Perls < 5.10.1 (with the exception of 5.8.9) have a performance problem with
481   # the substitutions below when dealing with strings stored internally in
482   # UTF-8, so downgrade them (if possible).
483   # Data passed to datasend() should be encoded to octets upstream already so
484   # shouldn't even have the UTF-8 flag on to start with, but if it so happens
485   # that the octets are stored in an upgraded string (as can sometimes occur)
486   # then they would still downgrade without fail anyway.
487   # Only Unicode codepoints > 0xFF stored in an upgraded string will fail to
488   # downgrade. We fail silently in that case, and a "Wide character in print"
489   # warning will be emitted later by syswrite().
490   utf8::downgrade($line, 1) if $] < 5.010001 && $] != 5.008009;
491
492   return 0
493     if $cmd->_is_closed;
494
495   my $last_ch = ${*$cmd}{'net_cmd_last_ch'};
496
497   # We have not send anything yet, so last_ch = "\012" means we are at the start of a line
498   $last_ch = ${*$cmd}{'net_cmd_last_ch'} = "\012" unless defined $last_ch;
499
500   return 1 unless length $line;
501
502   if ($cmd->debug) {
503     foreach my $b (split(/\n/, $line)) {
504       $cmd->debug_print(1, "$b\n");
505     }
506   }
507
508   $line =~ tr/\r\n/\015\012/ unless "\r" eq "\015";
509
510   my $first_ch = '';
511
512   if ($last_ch eq "\015") {
513     # Remove \012 so it does not get prefixed with another \015 below
514     # and escape the . if there is one following it because the fixup
515     # below will not find it
516     $first_ch = "\012" if $line =~ s/^\012(\.?)/$1$1/;
517   }
518   elsif ($last_ch eq "\012") {
519     # Fixup below will not find the . as the first character of the buffer
520     $first_ch = "." if $line =~ /^\./;
521   }
522
523   $line =~ s/\015?\012(\.?)/\015\012$1$1/sg;
524
525   substr($line, 0, 0) = $first_ch;
526
527   ${*$cmd}{'net_cmd_last_ch'} = substr($line, -1, 1);
528
529   $cmd->_syswrite_with_timeout($line)
530     or return;
531
532   1;
533 }
534
535
536 sub rawdatasend {
537   my $cmd  = shift;
538   my $arr  = @_ == 1 && ref($_[0]) ? $_[0] : \@_;
539   my $line = join("", @$arr);
540
541   return 0
542     if $cmd->_is_closed;
543
544   return 1
545     unless length($line);
546
547   if ($cmd->debug) {
548     my $b = "$cmd>>> ";
549     print STDERR $b, join("\n$b", split(/\n/, $line)), "\n";
550   }
551
552   $cmd->_syswrite_with_timeout($line)
553     or return;
554
555   1;
556 }
557
558
559 sub dataend {
560   my $cmd = shift;
561
562   return 0
563     if $cmd->_is_closed;
564
565   my $ch = ${*$cmd}{'net_cmd_last_ch'};
566   my $tosend;
567
568   if (!defined $ch) {
569     return 1;
570   }
571   elsif ($ch ne "\012") {
572     $tosend = "\015\012";
573   }
574
575   $tosend .= ".\015\012";
576
577   $cmd->debug_print(1, ".\n")
578     if ($cmd->debug);
579
580   $cmd->_syswrite_with_timeout($tosend)
581     or return 0;
582
583   delete ${*$cmd}{'net_cmd_last_ch'};
584
585   $cmd->response() == CMD_OK;
586 }
587
588 # read and write to tied filehandle
589 sub tied_fh {
590   my $cmd = shift;
591   ${*$cmd}{'net_cmd_readbuf'} = '';
592   my $fh = gensym();
593   tie *$fh, ref($cmd), $cmd;
594   return $fh;
595 }
596
597 # tie to myself
598 sub TIEHANDLE {
599   my $class = shift;
600   my $cmd   = shift;
601   return $cmd;
602 }
603
604 # Tied filehandle read.  Reads requested data length, returning
605 # end-of-file when the dot is encountered.
606 sub READ {
607   my $cmd = shift;
608   my ($len, $offset) = @_[1, 2];
609   return unless exists ${*$cmd}{'net_cmd_readbuf'};
610   my $done = 0;
611   while (!$done and length(${*$cmd}{'net_cmd_readbuf'}) < $len) {
612     ${*$cmd}{'net_cmd_readbuf'} .= $cmd->getline() or return;
613     $done++ if ${*$cmd}{'net_cmd_readbuf'} =~ s/^\.\r?\n\Z//m;
614   }
615
616   $_[0] = '';
617   substr($_[0], $offset + 0) = substr(${*$cmd}{'net_cmd_readbuf'}, 0, $len);
618   substr(${*$cmd}{'net_cmd_readbuf'}, 0, $len) = '';
619   delete ${*$cmd}{'net_cmd_readbuf'} if $done;
620
621   return length $_[0];
622 }
623
624
625 sub READLINE {
626   my $cmd = shift;
627
628   # in this context, we use the presence of readbuf to
629   # indicate that we have not yet reached the eof
630   return unless exists ${*$cmd}{'net_cmd_readbuf'};
631   my $line = $cmd->getline;
632   return if $line =~ /^\.\r?\n/;
633   $line;
634 }
635
636
637 sub PRINT {
638   my $cmd = shift;
639   my ($buf, $len, $offset) = @_;
640   $len ||= length($buf);
641   $offset += 0;
642   return unless $cmd->datasend(substr($buf, $offset, $len));
643   ${*$cmd}{'net_cmd_sending'}++;    # flag that we should call dataend()
644   return $len;
645 }
646
647
648 sub CLOSE {
649   my $cmd = shift;
650   my $r = exists(${*$cmd}{'net_cmd_sending'}) ? $cmd->dataend : 1;
651   delete ${*$cmd}{'net_cmd_readbuf'};
652   delete ${*$cmd}{'net_cmd_sending'};
653   $r;
654 }
655
656 1;
657
658 __END__
659
660
661 =head1 NAME
662
663 Net::Cmd - Network Command class (as used by FTP, SMTP etc)
664
665 =head1 SYNOPSIS
666
667     use Net::Cmd;
668
669     @ISA = qw(Net::Cmd);
670
671 =head1 DESCRIPTION
672
673 C<Net::Cmd> is a collection of methods that can be inherited by a sub-class
674 of C<IO::Socket::INET>. These methods implement the functionality required for a
675 command based protocol, for example FTP and SMTP.
676
677 If your sub-class does not also derive from C<IO::Socket::INET> or similar (e.g.
678 C<IO::Socket::IP>, C<IO::Socket::INET6> or C<IO::Socket::SSL>) then you must
679 provide the following methods by other means yourself: C<close()> and
680 C<timeout()>.
681
682 =head2 Public Methods
683
684 These methods provide a user interface to the C<Net::Cmd> object.
685
686 =over 4
687
688 =item C<debug($level)>
689
690 Set the level of debug information for this object. If C<$level> is not given
691 then the current state is returned. Otherwise the state is changed to 
692 C<$level> and the previous state returned. 
693
694 Different packages
695 may implement different levels of debug but a non-zero value results in 
696 copies of all commands and responses also being sent to STDERR.
697
698 If C<$level> is C<undef> then the debug level will be set to the default
699 debug level for the class.
700
701 This method can also be called as a I<static> method to set/get the default
702 debug level for a given class.
703
704 =item C<message()>
705
706 Returns the text message returned from the last command. In a scalar
707 context it returns a single string, in a list context it will return
708 each line as a separate element. (See L<PSEUDO RESPONSES> below.)
709
710 =item C<code()>
711
712 Returns the 3-digit code from the last command. If a command is pending
713 then the value 0 is returned. (See L<PSEUDO RESPONSES> below.)
714
715 =item C<ok()>
716
717 Returns non-zero if the last code value was greater than zero and
718 less than 400. This holds true for most command servers. Servers
719 where this does not hold may override this method.
720
721 =item C<status()>
722
723 Returns the most significant digit of the current status code. If a command
724 is pending then C<CMD_PENDING> is returned.
725
726 =item C<datasend($data)>
727
728 Send data to the remote server, converting LF to CRLF. Any line starting
729 with a '.' will be prefixed with another '.'.
730 C<$data> may be an array or a reference to an array.
731 The C<$data> passed in must be encoded by the caller to octets of whatever
732 encoding is required, e.g. by using the Encode module's C<encode()> function.
733
734 =item C<dataend()>
735
736 End the sending of data to the remote server. This is done by ensuring that
737 the data already sent ends with CRLF then sending '.CRLF' to end the
738 transmission. Once this data has been sent C<dataend> calls C<response> and
739 returns true if C<response> returns CMD_OK.
740
741 =back
742
743 =head2 Protected Methods
744
745 These methods are not intended to be called by the user, but used or 
746 over-ridden by a sub-class of C<Net::Cmd>
747
748 =over 4
749
750 =item C<debug_print($dir, $text)>
751
752 Print debugging information. C<$dir> denotes the direction I<true> being
753 data being sent to the server. Calls C<debug_text> before printing to
754 STDERR.
755
756 =item C<debug_text($dir, $text)>
757
758 This method is called to print debugging information. C<$text> is
759 the text being sent. The method should return the text to be printed.
760
761 This is primarily meant for the use of modules such as FTP where passwords
762 are sent, but we do not want to display them in the debugging information.
763
764 =item C<command($cmd[, $args, ... ])>
765
766 Send a command to the command server. All arguments are first joined with
767 a space character and CRLF is appended, this string is then sent to the
768 command server.
769
770 Returns undef upon failure.
771
772 =item C<unsupported()>
773
774 Sets the status code to 580 and the response text to 'Unsupported command'.
775 Returns zero.
776
777 =item C<response()>
778
779 Obtain a response from the server. Upon success the most significant digit
780 of the status code is returned. Upon failure, timeout etc., I<CMD_ERROR> is
781 returned.
782
783 =item C<parse_response($text)>
784
785 This method is called by C<response> as a method with one argument. It should
786 return an array of 2 values, the 3-digit status code and a flag which is true
787 when this is part of a multi-line response and this line is not the last.
788
789 =item C<getline()>
790
791 Retrieve one line, delimited by CRLF, from the remote server. Returns I<undef>
792 upon failure.
793
794 B<NOTE>: If you do use this method for any reason, please remember to add
795 some C<debug_print> calls into your method.
796
797 =item C<ungetline($text)>
798
799 Unget a line of text from the server.
800
801 =item C<rawdatasend($data)>
802
803 Send data to the remote server without performing any conversions. C<$data>
804 is a scalar.
805 As with C<datasend()>, the C<$data> passed in must be encoded by the caller
806 to octets of whatever encoding is required, e.g. by using the Encode module's
807 C<encode()> function.
808
809 =item C<read_until_dot()>
810
811 Read data from the remote server until a line consisting of a single '.'.
812 Any lines starting with '..' will have one of the '.'s removed.
813
814 Returns a reference to a list containing the lines, or I<undef> upon failure.
815
816 =item C<tied_fh()>
817
818 Returns a filehandle tied to the Net::Cmd object.  After issuing a
819 command, you may read from this filehandle using read() or <>.  The
820 filehandle will return EOF when the final dot is encountered.
821 Similarly, you may write to the filehandle in order to send data to
822 the server after issuing a command that expects data to be written.
823
824 See the Net::POP3 and Net::SMTP modules for examples of this.
825
826 =back
827
828 =head2 Pseudo Responses
829
830 Normally the values returned by C<message()> and C<code()> are
831 obtained from the remote server, but in a few circumstances, as
832 detailed below, C<Net::Cmd> will return values that it sets. You
833 can alter this behavior by overriding DEF_REPLY_CODE() to specify
834 a different default reply code, or overriding one of the specific
835 error handling methods below.
836
837 =over 4
838
839 =item Initial value
840
841 Before any command has executed or if an unexpected error occurs
842 C<code()> will return "421" (temporary connection failure) and
843 C<message()> will return undef.
844
845 =item Connection closed
846
847 If the underlying C<IO::Handle> is closed, or if there are
848 any read or write failures, the file handle will be forced closed,
849 and C<code()> will return "421" (temporary connection failure)
850 and C<message()> will return "[$pkg] Connection closed"
851 (where $pkg is the name of the class that subclassed C<Net::Cmd>).
852 The _set_status_closed() method can be overridden to set a different
853 message (by calling set_status()) or otherwise trap this error.
854
855 =item Timeout
856
857 If there is a read or write timeout C<code()> will return "421"
858 (temporary connection failure) and C<message()> will return
859 "[$pkg] Timeout" (where $pkg is the name of the class
860 that subclassed C<Net::Cmd>). The _set_status_timeout() method
861 can be overridden to set a different message (by calling set_status())
862 or otherwise trap this error.
863
864 =back
865
866 =head1 EXPORTS
867
868 The following symbols are, or can be, exported by this module:
869
870 =over 4
871
872 =item Default Exports
873
874 C<CMD_INFO>,
875 C<CMD_OK>,
876 C<CMD_MORE>,
877 C<CMD_REJECT>,
878 C<CMD_ERROR>,
879 C<CMD_PENDING>.
880
881 (These correspond to possible results of C<response()> and C<status()>.)
882
883 =item Optional Exports
884
885 I<None>.
886
887 =item Export Tags
888
889 I<None>.
890
891 =back
892
893 =head1 KNOWN BUGS
894
895 See L<https://rt.cpan.org/Dist/Display.html?Status=Active&Queue=libnet>.
896
897 =head1 AUTHOR
898
899 Graham Barr E<lt>L<gbarr@pobox.com|mailto:gbarr@pobox.com>E<gt>.
900
901 Steve Hay E<lt>L<shay@cpan.org|mailto:shay@cpan.org>E<gt> is now maintaining
902 libnet as of version 1.22_02.
903
904 =head1 COPYRIGHT
905
906 Copyright (C) 1995-2006 Graham Barr.  All rights reserved.
907
908 Copyright (C) 2013-2016, 2020 Steve Hay.  All rights reserved.
909
910 =head1 LICENCE
911
912 This module is free software; you can redistribute it and/or modify it under the
913 same terms as Perl itself, i.e. under the terms of either the GNU General Public
914 License or the Artistic License, as specified in the F<LICENCE> file.
915
916 =head1 VERSION
917
918 Version 3.12
919
920 =head1 DATE
921
922 09 Dec 2020
923
924 =head1 HISTORY
925
926 See the F<Changes> file.
927
928 =cut