/[nagios-plugins-perl]/trunk/plugins/check_mail_mx.pl
ViewVC logotype

Contents of /trunk/plugins/check_mail_mx.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 211 - (show annotations) (download)
Wed Apr 17 07:48:12 2019 UTC (19 months, 2 weeks ago) by xhumbert
File MIME type: text/plain
File size: 19261 byte(s)
Changed check SSL version
1 #!/usr/bin/perl -w
2 #
3 # Copyright (c) 2010-2011 St├ęphane Urbanovski <stephane.urbanovski@ac-nancy-metz.fr>
4 #
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty
12 # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # you should have received a copy of the GNU General Public License
16 # along with this program (or with Nagios); if not, write to the
17 # Free Software Foundation, Inc., 59 Temple Place - Suite 330,
18 # Boston, MA 02111-1307, USA
19 #
20 # This plugin is heavily based on Michal Ludvig's work "smtp-cli" :
21 # ------
22 # Command line SMTP client with STARTTLS, SMTP-AUTH and IPv6 support.
23 # Michal Ludvig <michal@logix.cz>, 2003-2009
24 # See http://www.logix.cz/michal/devel/smtp-cli for details.
25 # ------
26
27 use strict;
28 use warnings;
29
30 use POSIX qw( setlocale strftime );
31 use Locale::gettext;
32
33 use File::Basename; # get basename()
34 use Nagios::Plugin;
35
36 use Time::HiRes;
37 use Sys::Hostname;
38 use IO::Socket::INET;
39 use IO::Socket::SSL;
40 # use MIME::Base64 qw(encode_base64 decode_base64);
41 use Socket qw(:DEFAULT :crlf);
42 use Digest::HMAC_MD5;
43
44 use Net::DNS;
45 use Data::Dumper;
46
47 my $VERSION = '2.0';
48 my $TIMEOUT = 3;
49 my $PROGNAME = basename($0);
50
51
52 # i18n :
53 setlocale(LC_MESSAGES, '');
54 textdomain('nagios-plugins-perl');
55
56 # Don't use locale format for dates :
57 # setlocale(LC_TIME, 'C');
58 setlocale(2, 'C');
59 # LC_TIME sometime not exported by POSIX : bug ??
60
61
62
63 my $np = Nagios::Plugin->new(
64 version => $VERSION,
65 blurb => _gt('Search domain MX and check SMTP access.'),
66 usage => "Usage: %s -D <domain> [-t <timeout>] [ -c|--critical=<threshold> ] [ -w|--warning=<threshold> ]",
67 timeout => $TIMEOUT+1,
68 extra => &showExtra(),
69 );
70
71 $np->add_arg (
72 spec => 'port=i',
73 help => _gt('Server port ( default to 25 for smtp and 465 for smtps).'),
74 required => 0,
75 default => 0,
76 );
77 $np->add_arg (
78 spec => 'proto|P=s',
79 help => _gt('Protocol smtp(default)/smtps/tls.'),
80 default => 'auto',
81 required => 0,
82 );
83 $np->add_arg (
84 spec => 'domain|D=s',
85 help => _gt('Destination domain.'),
86 required => 0,
87 );
88
89 $np->add_arg (
90 spec => 'domain-level|L=i',
91 help => _gt('Number of element from hostname used to derive domain name (default: 2)'),
92 required => 0,
93 default => 2,
94 );
95
96 $np->add_arg (
97 spec => 'host|H=s',
98 help => _gt('imap/imaps server.'),
99 required => 0,
100 );
101
102
103 $np->add_arg (
104 spec => 'wt=f',
105 help => _gt('Warning request time threshold (in seconds)'),
106 default => 2,
107 required => 0,
108 label => 'FLOAT'
109 );
110 $np->add_arg (
111 spec => 'ct=f',
112 help => _gt('Critical request time threshold (in seconds)'),
113 default => 10,
114 required => 0,
115 label => 'FLOAT'
116 );
117
118 $np->add_arg (
119 spec => 'up=i',
120 help => _gt('Minimum number of server up'),
121 default => 1,
122 required => 0,
123 );
124 $np->getopts;
125
126 my $port = $np->opts->get('port');
127
128 my $proto = $np->opts->get('proto');
129
130 my $domain = $np->opts->get('domain');
131 my $host = $np->opts->get('host');
132 my $domainLevel = $np->opts->get('domain-level');
133
134 my $up = $np->opts->get('up');
135
136
137 my $verbose = $np->opts->verbose;
138 # time
139 my $warn_t = $np->opts->get('wt');
140 my $crit_t = $np->opts->get('ct');
141
142 my $hostname = hostname();
143
144
145 if ( !defined( $domain ) ) {
146 $domain = '';
147 if ( !defined( $host ) ) {
148 $np->nagios_exit(CRITICAL, _gt("--host or --domain option required !") );
149 }
150 my $dl = 0;
151 my @tmp = ();
152 foreach my $e ( reverse(split(/\./,$host)) ) {
153 if ( $dl++ >= $domainLevel ) {
154 last;
155 }
156 unshift( @tmp, $e);
157 }
158 $domain = join('.',@tmp);
159 }
160 logD ("Searching MX for domain ".$domain);
161
162 my $date = &getDate();
163
164 my $addr_family = AF_UNSPEC;
165 # my $hello_host = $hostname;
166
167 ## IO::Socket::INET6 and Socket6 are optional
168 my $have_ipv6 = eval { require IO::Socket::INET6; require Socket6; 1; };
169
170
171 if ($proto ne 'smtp') {
172 # Do Net::SSLeay initialization
173 Net::SSLeay::load_error_strings();
174 Net::SSLeay::SSLeay_add_ssl_algorithms();
175 Net::SSLeay::randomize();
176
177 if ( $proto eq 'smtps' ) {
178 $port ||= 465;
179 }
180 }
181
182 $port ||= 25;
183
184
185
186
187 my $dnsResolver = Net::DNS::Resolver->new;
188 my @mx = mx($dnsResolver,$domain);
189
190 unless ( @mx ) {
191 logW('DNS ERROR:'.$dnsResolver->errorstring());
192 $np->nagios_exit(CRITICAL, sprintf(_gt("DNS search for '%s' MX servers failed : %s"),$domain,$dnsResolver->errorstring()) );
193 }
194
195 # print 'MX:'.Dumper(@mx);
196
197 my $mxCount = 0;
198
199 my %smtpServerPref = ();
200
201 foreach my $rr ( @mx ) {
202 if ( defined($rr->exchange) && defined($rr->preference) ) {
203 $smtpServerPref{$rr->exchange} = $rr->preference;
204 $mxCount++;
205 } else {
206 logD ("Ignoring ".Dumper(\$rr));
207 }
208 }
209
210 # foreach my $name (sort { $planets{$a} <=> $planets{$b} } keys %planets) {
211
212 my $mxUp = 0;
213 my $mxTested = 0;
214
215 foreach my $smtp_server ( sort { $smtpServerPref{$a} <=> $smtpServerPref{$b} } keys(%smtpServerPref) ) {
216
217 my $startTime = Time::HiRes::time();
218
219 logD ("Connection to ".$smtp_server.' ('.$smtpServerPref{$smtp_server}.')');
220
221 my $smtpHandler = new SMTP::All (
222 smtp_server => $smtp_server,
223 port => $port,
224 proto => $proto,
225 timeout => $TIMEOUT,
226 );
227
228 $mxTested++;
229
230 if ( !$smtpHandler->connect() ) {
231 logW ("SMTP connection to ".$smtp_server." failled :".$smtpHandler->getErrorMsg());
232 next;
233 }
234 if ( !$smtpHandler->hello() ) {
235 logW ("SMTP hello to ".$smtp_server." failled :".$smtpHandler->getErrorMsg());
236 next;
237 }
238
239 if ( ($proto eq 'tls' || $proto eq 'auto' ) && $smtpHandler->hasFeature('STARTTLS') ) {
240 if ( !$smtpHandler->startTls() ) {
241 logW ("STARTTLS to ".$smtp_server." failled :".$smtpHandler->getErrorMsg());
242 next;
243 }
244 if ( !$smtpHandler->hello() ) {
245 logW ("STARTTLS hello to ".$smtp_server." failled :".$smtpHandler->getErrorMsg());
246 next;
247 }
248 $proto = 'tls';
249
250 } elsif ($proto eq 'tls') {
251 logW ("TLS not supported by ".$smtp_server);
252 next;
253 }
254
255 if ( !$smtpHandler->quit() ) {
256 $np->add_message(WARNING, _gt("QUIT command failled: ").$smtpHandler->getErrorMsg() );
257 next;
258 }
259
260 # Check timer value
261
262 my $timer = Time::HiRes::time() - $startTime;
263
264
265 logD ("Connection to ".$smtp_server. ' : OK ');
266 $mxUp++;
267
268 if ( $mxUp == 1 ) {
269 my $status_t = $np->check_threshold(
270 'check' => $timer,
271 'warning' => $warn_t,
272 'critical' => $crit_t,
273 );
274 $np->add_perfdata(
275 'label' => 't',
276 'value' => sprintf('%.6f',$timer),
277 'min' => 0,
278 'uom' => 's',
279 'threshold' => $np->threshold()
280 );
281
282 if ( $status_t > WARNING ) {
283 $np->add_message($status_t, sprintf(_gt("SMTP connexion too long for '%s' : %.2ds !"),$smtp_server, $timer) );
284 $mxUp--;
285 next;
286 }
287 }
288
289 if ( $mxUp >= $up ) {
290 last;
291 }
292 }
293
294 if ( $mxCount == 0 ) {
295 $np->nagios_exit(CRITICAL, sprintf(_gt("No MX found for domain '%s' !"),$domain) );
296 }
297
298 if ( $mxUp == $mxCount ) {
299 $np->add_message(OK, sprintf(_gt("All MX server from domain '%s' are UP (%d/%d)"), $domain, $mxUp, $mxCount) );
300
301 } elsif ( $mxUp > 0 ) {
302 if ( $mxUp == 1 && $mxTested == 1) {
303 $np->add_message(OK, sprintf(_gt("First MX server from domain '%s' is UP (%d/%d)"), $domain, $mxUp, $mxCount) );
304
305 } elsif ( $mxUp == $mxTested ) {
306 $np->add_message(OK, sprintf(_gt("All %d prefered MX servers from domain '%s' are UP (%d/%d)"), $mxUp, $domain, $mxUp, $mxCount) );
307
308 } else {
309 $np->add_message(WARNING, sprintf(_gt("At least %d MX servers from domain '%s' are UP (%d/%d)"), $mxUp, $domain, $mxUp, $mxCount) );
310 }
311
312 } else {
313 $np->add_message(CRITICAL, sprintf(_gt("No MX server available for domain '%s' !"),$domain) );
314
315 }
316
317
318
319
320 my ($status, $message) = $np->check_messages('join' => ' ');
321 $np->nagios_exit($status, $message );
322
323
324 sub getDate {
325 my $time = $_[0] || time();
326 # return strftime('%A %e %B %Y %H:%M:%S', localtime($time))
327 # return strftime('%a, %d %b %Y %H:%M:%S GMT', gmtime($time));
328 return strftime('%a, %d %b %Y %H:%M:%S %z', localtime($time));
329 }
330 sub logD {
331 print STDERR 'DEBUG: '.$_[0]."\n" if ($verbose);
332 }
333 sub logW {
334 print STDERR 'WARNING: '.$_[0]."\n" if ($verbose);
335 }
336 # Gettext wrapper
337 sub _gt {
338 return gettext($_[0]);
339 }
340
341 sub showExtra {
342 return <<EOT;
343 (c)2016 St├ęphane Urbanovski <s.urbanovski\@ac-nancy-metz.fr>
344
345
346 EOT
347 }
348
349
350
351 package SMTP::All;
352
353
354 use strict;
355 use warnings;
356
357
358 use POSIX qw(mktime);
359 # use Locale::gettext;
360
361 use Sys::Hostname;
362 use IO::Socket::INET;
363 use IO::Socket::SSL;
364 use MIME::Base64 qw(encode_base64 decode_base64);
365 use Socket qw(:DEFAULT :crlf);
366
367
368 use Data::Dumper;
369 sub new {
370 my $class = shift;
371
372 my %args = @_;
373
374 my $self = {
375 'use_ipv6' => 0,
376 'smtp_server' => undef,
377 'port' => 0,
378 'proto' => 'auto',
379 'timeout' => 20,
380 'helloCmd' => 'EHLO',
381 'helloHost' => hostname() || 'localhost',
382 'srvFeatures' => {},
383 'isSecure' => 0,
384 'msgId' => '??',
385 'errmsg' => '',
386 '_sock' => undef,
387 };
388
389 foreach my $arg ( keys(%args) ) {
390 if ( exists($self->{$arg}) ) {
391 $self->{$arg} = $args{$arg};
392 }
393 }
394
395 if ( $self->{'port'} == 0 && $self->{'proto'} eq 'smtps' ) {
396 $self->{'port'} = 465;
397 }
398
399 bless $self, $class;
400 return $self;
401 }
402
403
404 # Store all server's ESMTP features to a hash.
405 sub hello {
406 my ($self) = @_;
407
408 $self->send_line ($self->{'helloCmd'}.' '.$self->{'helloHost'});
409 my ($code, $text, $more) = (0,'',1);
410
411 # Empty the hash
412 $self->{'srvFeatures'} = {};
413
414 # Load all features presented by the server into the hash
415 while ($more == 1) {
416 ($code, $text, $more) = $self->get_one_line ();
417 if ($code != 250) {
418 $self->{'errmsg'} = "$code '$text'";
419 return 0;
420 }
421 my ($feat, $param) = ($text =~ /^(\w+)[= ]*(.*)$/);
422 $self->{'srvFeatures'}->{$feat} = $param;
423 }
424
425 return 1;
426 }
427
428 # check if a server feature is present (from hello response)
429 sub hasFeature ($) {
430 my ($self,$feat) = @_;
431 return exists($self->{'srvFeatures'}->{$feat});
432 }
433
434 # is SSL/TLS active ?
435 sub isSecure () {
436 my ($self) = @_;
437 return $self->{'isSecure'};
438 }
439
440 # get last error message
441 sub getErrorMsg () {
442 my ($self) = @_;
443 return $self->{'errmsg'};
444 }
445
446 # get last message id (received by server)
447 sub getLastMsgId () {
448 my ($self) = @_;
449 return $self->{'msgId'};
450 }
451
452 # Check server SSL certificate (CN / notAfter).
453 sub checkSSL {
454 my ($self) = @_;
455
456 # $self->logD ("Using cipher: ". $self->{'_sock'}->get_cipher ());
457 # $self->logD ( $self->{'_sock'}->dump_peer_certificate());
458 #
459 my $ssl = $self->{'_sock'}->_get_ssl_object();
460
461 my $x509_cert = Net::SSLeay::get_peer_certificate($ssl);
462
463 my $x509_subject = Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($x509_cert));
464
465 if ( $x509_subject =~ /cn=([^\/]+)/i ) {
466 $self->{'cert_CN'} = $1;
467 $self->logD ( 'cert_CN='.$self->{'cert_CN'} ) ;
468 }
469
470
471 my $x509_notAfter = Net::SSLeay::P_ASN1_UTCTIME_put2string(Net::SSLeay::X509_get_notAfter($x509_cert));
472 $self->logD ( 'cert_notAfter='.$x509_notAfter); # Apr 8 15:05:33 2012 GMT
473
474
475 my %month = (
476 'jan' => 0,
477 'feb' => 1,
478 'mar' => 2,
479 'apr' => 3,
480 'may' => 4,
481 'jun' => 5,
482 'jul' => 6,
483 'aug' => 7,
484 'sep' => 8,
485 'oct' => 9,
486 'nov' => 10,
487 'dec' => 11,
488
489 );
490
491 my $naTime = 0;
492 if ( $x509_notAfter =~ /^(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)\s+(\d+)\s+GMT$/ ) {
493 # 1 2 3 4 5 6
494 if ( exists($month{lc($1)}) ) {
495 $naTime = mktime($5,$4,$3,$2,$month{lc($1)},$6-1900);
496 } else {
497 $self->logD ( 'bad format for cert_notAfter !');
498 }
499 } else {
500 $self->logD ( 'bad format for cert_notAfter 2!');
501 }
502
503
504 $self->logD ( 'cert_notAfter='.localtime($naTime));
505 }
506
507 # Connect to the SMTP server.
508 sub connect {
509 my ($self) = @_;
510
511 my %connect_args = (
512 PeerAddr => $self->{'smtp_server'},
513 PeerPort => $self->{'port'},
514 Proto => 'tcp',
515 Timeout => $self->{'timeout'},
516 );
517
518 $self->logD("Connect to ".$self->{'smtp_server'}.':'.$self->{'port'}.' ('.$self->{'proto'}.')');
519
520 if ($self->{'use_ipv6'}) {
521 $connect_args{'Domain'} = $addr_family;
522 $self->{'_sock'} = IO::Socket::INET6->new(%connect_args);
523
524 } elsif ($self->{'proto'} eq 'smtps') {
525
526 $self->{'_sock'} = IO::Socket::SSL->new(%connect_args);
527 if (! $self->{'_sock'} ) {
528 $self->{'errmsg'} = "SMTPS: ".IO::Socket::SSL::errstr();
529 return 0;
530 }
531
532 } else {
533 $self->{'_sock'} = IO::Socket::INET->new(%connect_args);
534 }
535
536 if ( !$self->{'_sock'} ) {
537 $self->{'errmsg'} = "Connect failed: ".$@;
538 $self->logW ($self->{'errmsg'});
539 return 0;
540 }
541
542 # TODO: check this
543 # my $addr_fmt = "%s";
544 # $addr_fmt = "[%s]" if ($sock->sockhost() =~ /:/); ## IPv6 connection
545
546 $self->logD(sprintf ("Connection from %s:%s to %s:%s", $self->{'_sock'}->sockhost(), $self->{'_sock'}->sockport(), $self->{'_sock'}->peerhost(), $self->{'_sock'}->peerport()) );
547
548 # Wait for the welcome message of the server.
549 my ($code, $text) = $self->get_line ();
550 if ($code != 220) {
551 $self->{'errmsg'} = "Unknown welcome string: $code '$text'";
552 $self->logW ($self->{'errmsg'});
553 return 0;
554 }
555
556 if ($self->{'proto'} eq 'smtps') {
557 $self->{'isSecure'} = 1;
558 }
559
560 if ($text !~ /ESMTP/) {
561 $self->{'helloCmd'} = 'HELO';
562 }
563
564 return 1;
565
566 }
567
568
569 sub startTls () {
570 my ($self) = @_;
571
572 if ( $self->hasFeature('STARTTLS') || $self->hasFeature('TLS') ) {
573 $self->logD ("Starting TLS...");
574
575 $self->send_line ('STARTTLS');
576 my ($code, $text) = $self->get_line ();
577
578 if ($code != 220) {
579 $self->{'errmsg'} = "Unknown STARTTLS response : $code '$text'." ;
580 return 0;
581 }
582
583 if (! IO::Socket::SSL::socket_to_SSL($self->{'_sock'})) {
584 $self->{'errmsg'} = "STARTTLS: ".IO::Socket::SSL::errstr();
585 return 0;
586 }
587
588 # $self->logD ("Using cipher: ".$self->{'_sock'}->get_cipher ());
589 # $self->logD ( $self->{'_sock'}->dump_peer_certificate());
590
591 $self->{'isSecure'} = 1;
592
593 return 1;
594
595 } else {
596 $self->{'errmsg'} = "STARTTLS unsupported by server";
597 $self->logW ($self->{'errmsg'});
598 return 0;
599 }
600 }
601
602
603 sub auth {
604 my ($self,$user,$pass) = @_;
605
606 # See if we should authenticate ourself
607 if ( !$self->hasFeature('AUTH')) {
608 $self->{'errmsg'} = "AUTH unsupported by server";
609 $self->logW ($self->{'errmsg'});
610 return 0;
611 }
612
613 $self->logD ("AUTH methods: ". $self->{'srvFeatures'}{'AUTH'});
614
615 if ( $self->{'srvFeatures'}{'AUTH'} =~ /CRAM-MD5/i ) {
616 # Try CRAM-MD5 if supported by the server
617 my $authMethod = 'AUTH CRAM-MD5';
618
619 $self->logD ("using $authMethod");
620
621 $self->send_line($authMethod);
622 my ($code, $text) = $self->get_line();
623
624 if ($code != 334) {
625 $self->{'errmsg'} = "$authMethod command failed: $code '$text'";
626 $self->logW ($self->{'errmsg'});
627 return 0;
628 }
629
630 my $response = $self->encode_cram_md5($text, $user, $pass);
631 $self->send_line ($response);
632
633 ($code, $text) = $self->get_line();
634 if ($code != 235) {
635 $self->{'errmsg'} = "$authMethod chalenge failed: $code '$text'";
636 $self->logW ($self->{'errmsg'});
637 return 0;
638 }
639
640 } elsif ($self->{'srvFeatures'}{'AUTH'} =~ /LOGIN/i ) {
641 # Eventually try LOGIN method
642
643 my $authMethod = 'AUTH LOGIN';
644
645 $self->logD ("using $authMethod");
646
647 $self->send_line ($authMethod);
648 my ($code, $text) = $self->get_line();
649
650 if ($code != 334) {
651 $self->{'errmsg'} = "$authMethod command failed: $code '$text'";
652 $self->logW ($self->{'errmsg'});
653 return 0;
654 }
655
656 $self->send_line(encode_base64 ($user, ""));
657 ($code, $text) = $self->get_line();
658
659 if ($code != 334) {
660 $self->{'errmsg'} = "$authMethod chalenge failed: $code '$text'";
661 $self->logW ($self->{'errmsg'});
662 return 0;
663 }
664
665 $self->send_line(encode_base64 ($pass, ""));
666 ($code, $text) = $self->get_line();
667
668 if ($code != 235) {
669 $self->{'errmsg'} = "$authMethod chalenge failed: $code '$text'";
670 $self->logW ($self->{'errmsg'});
671 return 0;
672 }
673
674
675 } elsif ($self->{'srvFeatures'}{'AUTH'} =~ /PLAIN/i ) {
676 # Or finally PLAIN if nothing else was supported.
677
678 my $authMethod = 'AUTH PLAIN';
679
680 $self->logD ("using $authMethod");
681
682 $self->send_line("AUTH PLAIN ". encode_base64 ("$user\0$user\0$pass", ""));
683 my ($code, $text) = $self->get_line();
684
685 if ($code != 235) {
686 $self->{'errmsg'} = "$authMethod chalenge failed: $code '$text'";
687 $self->logW ($self->{'errmsg'});
688 return 0;
689 }
690
691 } else {
692 # Complain otherwise.
693
694 $self->{'errmsg'} = "No supported authentication method advertised by the server.";
695 $self->logW ($self->{'errmsg'});
696 return 0;
697 }
698
699 $self->logD ("Authentication of $user\@".$self->smtp_server." succeeded");
700 return 1;
701
702 }
703
704
705 # send SMTP envelope
706 sub envelope {
707 my ($self,$mail_sender,$mail_addr) = @_;
708 # We can do a relay-test now if a recipient was set.
709
710 $self->send_line("MAIL FROM: <$mail_sender>");
711 my ($code, $text) = $self->get_line();
712
713 if ($code != 250) {
714 $self->{'errmsg'} = "MAIL FROM <".$mail_sender."> failed: $code '$text'";
715 $self->logW ($self->{'errmsg'});
716 return 0;
717 }
718
719 $self->send_line("RCPT TO: <$mail_addr>");
720 ($code, $text) = $self->get_line();
721
722 if ($code != 250) {
723 $self->{'errmsg'} = "RCPT TO <".$mail_addr."> failed: $code '$text'";
724 $self->logW ($self->{'errmsg'});
725 return 0;
726 }
727 return 1;
728 }
729
730 # send SMTP envelope
731 sub data {
732 my ($self,@data) = @_;
733
734 $self->send_line("DATA");
735 my ($code, $text) = $self->get_line();
736
737 if ($code != 354) {
738 $self->{'errmsg'} = "DATA failed: $code '$text'";
739 $self->logW ($self->{'errmsg'});
740 return 0;
741 }
742
743 foreach my $line (@data) {
744 $line =~ s/^\.$/\. /; # escape single point
745 $self->send_line($line);
746 }
747
748 # End DATA
749 $self->send_line('.');
750 ($code, $text) = $self->get_line();
751
752 if ($code != 250) {
753 $self->{'errmsg'} = "DATA not send: $code '$text'";
754 $self->logW ($self->{'errmsg'});
755 return 0;
756 }
757
758 if ($text =~ /queued as ([A-Z0-9]+)/) {
759 $self->{'msgId'} = $1;
760 }
761
762 return 1;
763 }
764
765
766 # Good bye...
767 sub quit ($) {
768 my ($self) = @_;
769
770 $self->send_line('QUIT');
771 my ($code, $text) = $self->get_line();
772
773 if ($code != 221) {
774 $self->{'errmsg'} = "Unknown QUIT response: $code '$text'";
775 $self->logW ($self->{'errmsg'});
776 return 0;
777 }
778 return 1;
779 }
780
781
782 # Get one line of response from the server.
783 sub get_one_line ($) {
784 my ($self) = @_;
785 my ($code, $sep, $text) = ($self->{'_sock'}->getline() =~ /(\d+)(.)([^\r]*)/);
786 my $more = ($sep eq "-");
787 $self->logD("[$code] '$text'");
788 return ($code, $text, $more);
789 }
790
791 # Get concatenated lines of response from the server.
792 sub get_line () {
793 my ($self) = @_;
794 my ($firstcode, $text, $more) = $self->get_one_line();
795 while ($more) {
796 my ($code, $line);
797 ($code, $line, $more) = $self->get_one_line();
798 $text .= " $line";
799 # FIXME: handle this properly
800 die ("Error code changed from $firstcode to $code. That's illegal.\n") if ($firstcode ne $code);
801 }
802 return ($firstcode, $text);
803 }
804
805 # Send one line back to the server
806 sub send_line ($) {
807 my ($self,$l) = @_;
808 $self->logD( "> $l");
809 $l =~ s/\n/$CRLF/g;
810 return $self->{'_sock'}->print ($l.$CRLF);
811 }
812
813 sub encode_cram_md5 ($$$) {
814 my ($self,$ticket64, $username, $password) = @_;
815 my $ticket = decode_base64($ticket64);
816 if ( !$ticket ) {
817 $self->{'errmsg'} = "Unable to decode Base64 encoded string '$ticket64'";
818 $self->logW ($self->{'errmsg'});
819 return 0;
820 }
821
822 # print "Decoded CRAM-MD5 challenge: $ticket\n" if ($verbose > 1);
823 my $password_md5 = Digest::HMAC_MD5::hmac_md5_hex($ticket, $password);
824 return encode_base64 ("$username $password_md5", "");
825 }
826
827
828 sub logD {
829 my ($self) = shift;
830 print STDERR 'DEBUG: '.$_[0]."\n" if ($verbose);
831 }
832 sub logW {
833 my ($self) = shift;
834 print STDERR 'WARNING: '.$_[0]."\n" if ($verbose);
835 }
836
837 1;

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.8