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

Contents of /trunk/plugins/check_mail_smtp.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.8