2 =head1 NAME
4 mailqueue.pm
6 =head1 SYNOPSIS
8 use GOSA::GosaSupportDaemon;
10 =head1 DESCRIPTION
12 This module contains all GOsa-SI-client processing instructions concerning the mailqueue in GOsa.
14 =head1 VERSION
16 Version 1.0
18 =head1 AUTHOR
20 Andreas Rettenberger <rettenberger at gonicus dot de>
22 =head1 FUNCTIONS
24 =cut
27 package mailqueue;
30 use strict;
31 use warnings;
33 use Exporter;
34 use GOSA::GosaSupportDaemon;
35 use MIME::Base64;
37 our @ISA = qw(Exporter);
39 my @events = (
40 "get_events",
41 "mailqueue_query",
42 "mailqueue_hold",
43 "mailqueue_unhold",
44 "mailqueue_requeue",
45 "mailqueue_del",
46 "mailqueue_header",
47 );
49 our @EXPORT = @events;
51 BEGIN {}
53 END {}
56 ###############################################################################
57 =over
59 =item B<get_events ()>
61 =over
63 =item description
65 Reports all provided functions.
67 =item parameter
69 None.
71 =item return
73 \@events - ARRAYREF - array containing all functions
75 =back
77 =back
79 =cut
80 ###############################################################################
81 sub get_events { return \@events; }
84 ###############################################################################
85 =over
87 =item B<mailqueue_query ($$)>
89 =over
91 =item description
93 Executes /usr/sbin/mailq, parse the informations and return them
95 =item parameter
97 $msg - STRING - complete GOsa-si message
98 $msg_hash - HASHREF - content of GOsa-si message in a hash
100 =item GOsa-si message xml content
102 None.
104 =item return
106 $out_msg - STRING - GOsa-SI valid xml message containing msg_id, msg_hold, msg_size, arrival_time, sender and recipient.
108 =back
110 =back
112 =cut
113 ###############################################################################
114 sub mailqueue_query {
115 my ($msg, $msg_hash) = @_;
116 my $header = @{$msg_hash->{'header'}}[0];
117 my $source = @{$msg_hash->{'source'}}[0];
118 my $target = @{$msg_hash->{'target'}}[0];
119 my $session_id = @{$msg_hash->{'session_id'}}[0];
120 # q_tag can be: msg_id | msg_hold | msg_size | arrival_time | sender | recipient
121 my $q_tag = exists $msg_hash->{'q_tag'} ? @{$msg_hash->{'q_tag'}}[0] : undef ;
122 # q_operator can be: eq | gt | lt
123 my $q_operator = exists $msg_hash->{'q_operator'} ? @{$msg_hash->{'q_operator'}}[0] : undef ;
124 my $q_value = exists $msg_hash->{'q_value'} ? @{$msg_hash->{'q_value'}}[0] : undef ;
125 my $error = 0;
126 my $error_string;
127 my $msg_id;
128 #my $msg_hold;
129 #my $msg_size;
130 #my $arrival_time;
131 my $sender;
132 my $recipient;
133 #my $status_message;
134 my $out_hash;
135 my $out_msg;
137 &main::daemon_log("DEBUG: run /usr/bin/mailq\n", 7);
138 my $result = qx("/usr/bin/mailq");
139 my @result_l = split(/([0-9A-Z]{10,12})/, $result);
141 if (length($result) == 0) {
142 $error = 1;
143 $error_string = "/usr/bin/mailq has no result";
144 &main::daemon_log("ERROR: $error_string : $msg", 1);
145 }
147 my $result_collection = {};
148 if (not $error) {
149 # parse information
150 my $result_length = @result_l;
151 my $j = 0;
152 for (my $i = 1; $i < $result_length; $i+=2) {
154 # Fetch and prepare all information
155 my $act_result;
156 $act_result->{'msg_id'} = $result_l[$i];
157 $result_l[$i+1] =~ /^([\!| ])\s+(\d+)\s+(\w{3}\s+\w{3}\s+\d+\s+\d+:\d+:\d+)\s+([\w.-]+@[\w.-]+)\s+/ ;
158 $act_result->{'msg_hold'} = $1 eq "!" ? 1 : 0 ;
159 $act_result->{'msg_size'} = $2;
160 $act_result->{'arrival_time'} = $3;
161 $act_result->{'sender'} = $4;
162 my @info_l = split(/\n/, $result_l[$i+1]);
163 $act_result->{'recipient'} = $info_l[2] =~ /([\w.-]+@[\w.-]+)/ ? $1 : 'unknown' ;
164 $act_result->{'msg_status'} = $info_l[1] =~ /^([\s\S]*)$/ ? $1 : 'unknown' ;
166 # If all query tags exists, perform the selection
167 my $query_positiv = 0;
168 if (defined $q_tag && defined $q_operator && defined $q_value) {
170 # Query for message id
171 if ( $q_tag eq 'msg_id') {
172 if (not $q_operator eq 'eq') {
173 &main::daemon_log("$session_id WARNING: query option '$q_operator' is not allowed with query tag '$q_tag'".
174 ", return return complete mail queue as fallback", 3);
175 &main::daemon_log("$session_id DEBUG: \n$msg", 9);
176 $query_positiv++;
177 } else {
178 if ( &_exec_op($act_result->{'msg_id'}, $q_operator, $q_value) ) {
179 $query_positiv++;
180 }
181 }
183 # Query for message size
184 } elsif ($q_tag eq 'msg_size') {
185 my $result_size = int($act_result->{'msg_size'});
186 my $query_size = int($q_value);
187 if ( &_exec_op($result_size, $q_operator, $query_size) ) {
188 $query_positiv++;
189 }
191 # Query for arrival time
192 } elsif ($q_tag eq 'arrival_time') {
193 my $result_time = int(&_parse_mailq_time($act_result->{'arrival_time'}));
194 my $query_time = int($q_value);
196 if ( &_exec_op($result_time, $q_operator, $query_time) ) {
197 $query_positiv++;
198 }
200 # Query for sender
201 }elsif ($q_tag eq 'sender') {
202 if (not $q_operator eq 'eq') {
203 &main::daemon_log("$session_id WARNING: query option '$q_operator' is not allowed with query tag '$q_tag'".
204 ", return return complete mail queue as fallback", 3);
205 &main::daemon_log("$session_id DEBUG: \n$msg", 9);
206 $query_positiv++;
207 } else {
208 if ( &_exec_op($act_result->{'sender'}, $q_operator, $q_value)) {
209 $query_positiv++;
210 }
211 }
213 # Query for recipient
214 } elsif ($q_tag eq 'recipient') {
215 if (not $q_operator eq 'eq') {
216 &main::daemon_log("$session_id WARNING: query option '$q_operator' is not allowed with query tag '$q_tag'".
217 ", return return complete mail queue as fallback", 3);
218 &main::daemon_log("$session_id DEBUG: \n$msg", 9);
219 $query_positiv++;
220 } else {
221 if ( &_exec_op($act_result->{'recipient'}, $q_operator, $q_value)) {
222 $query_positiv++;
223 }
224 }
225 }
227 # If no query tag exists, return all mails in mailqueue
228 } elsif ((not defined $q_tag) && (not defined $q_operator) && (not defined $q_value)) {
229 $query_positiv++;
231 # If query tags are not complete return error message
232 } elsif ((not defined $q_tag) || (not defined $q_operator) || (not defined $q_value)) {
233 $error++;
234 $error_string = "'mailqueue_query'-msg is not complete, some query tags (q_tag, q_operator, q_value) are missing";
235 &main::daemon_log("$session_id WARNING: $error_string", 3);
236 }
238 # If query was successful, add results to answer
239 if ($query_positiv) {
240 $j++;
241 foreach my $key (keys %{ $act_result }) {
242 $act_result->{$key} =~ s/\</\<\;/g;
243 $act_result->{$key} =~ s/\>/\>\;/g;
244 }
245 $result_collection->{$j} = $act_result;
246 }
247 }
248 }
250 #create outgoing msg
251 $out_hash = &main::create_xml_hash("answer_$session_id", $target, $source);
252 &add_content2xml_hash($out_hash, "session_id", $session_id);
253 &add_content2xml_hash($out_hash, "error", $error);
254 if (defined @{$msg_hash->{'forward_to_gosa'}}[0]){
255 &add_content2xml_hash($out_hash, "forward_to_gosa", @{$msg_hash->{'forward_to_gosa'}}[0]);
256 }
258 # add error infos to outgoing msg
259 if ($error) {
260 &add_content2xml_hash($out_hash, "error_string", $error_string);
261 $out_msg = &main::create_xml_string($out_hash);
263 # add mail infos to outgoing msg
264 } else {
265 my $collection_string = &db_res2xml($result_collection);
266 $out_msg = &main::create_xml_string($out_hash);
267 $out_msg =~ s/<\/xml>/$collection_string<\/xml>/
268 }
270 return $out_msg;
272 }
275 ###############################################################################
276 =over
278 =item B<mailqueue_hold ($$)>
280 =over
282 =item description
284 Executes '/usr/sbin/postsuper -h' and set mail to hold.
286 =item parameter
288 $msg - STRING - complete GOsa-si message
289 $msg_hash - HASHREF - content of GOsa-si message in a hash
291 =item GOsa-si message xml content
293 <msg_id> - STRING - postfix mail id
295 =item return
297 Nothing.
299 =back
301 =back
303 =cut
304 ###############################################################################
305 sub mailqueue_hold {
306 my ($msg, $msg_hash) = @_;
307 my $header = @{$msg_hash->{'header'}}[0];
308 my $source = @{$msg_hash->{'source'}}[0];
309 my $target = @{$msg_hash->{'target'}}[0];
310 my $session_id = @{$msg_hash->{'session_id'}}[0];
311 my $error = 0;
312 my $error_string;
314 # sanity check of input
315 if (not exists $msg_hash->{'msg_id'}) {
316 $error_string = "Message doesn't contain a XML tag 'msg_id";
317 &main::daemon_log("ERROR: $error_string : $msg", 1);
318 $error = 1;
319 } elsif (ref @{$msg_hash->{'msg_id'}}[0] eq "HASH") {
320 $error_string = "XML tag 'msg_id' is empty";
321 &main::daemon_log("ERROR: $error_string : $msg", 1);
322 $error = 1;
323 }
325 if (not $error) {
326 my @msg_ids = @{$msg_hash->{'msg_id'}};
327 foreach my $msg_id (@msg_ids) {
328 my $error = 0; # clear error status
330 # sanity check of each msg_id
331 if (not $msg_id =~ /^[0-9A-Z]{10,12}$/) {
332 $error = 1;
333 $error_string = "message ID is not valid ([0-9A-Z]{10,12}) : $msg_id";
334 &main::daemon_log("ERROR: $error_string : $msg", 1);
335 }
337 if (not $error) {
338 my $cmd = "/usr/sbin/postsuper -h $msg_id 2>&1";
339 &main::daemon_log("DEBUG: run $cmd", 7);
340 my $result = qx($cmd);
341 if ($result =~ /^postsuper: ([0-9A-Z]{10}): placed on hold/ ) {
342 &main::daemon_log("INFO: Mail $msg_id placed on hold", 5);
343 } elsif ($result eq "") {
344 &main::daemon_log("INFO: Mail $msg_id is alread placed on hold", 5);
346 } else {
347 &main::daemon_log("ERROR: '$cmd' failed : $result", 1);
348 }
349 }
350 }
351 }
353 return;
354 }
356 ###############################################################################
357 =over
359 =item B<mailqueue_unhold ($$)>
361 =over
363 =item description
365 Executes '/usr/sbin/postsuper -H' and set mail to unhold.
367 =item parameter
369 $msg - STRING - complete GOsa-si message
370 $msg_hash - HASHREF - content of GOsa-si message in a hash
372 =item GOsa-si message xml content
374 <msg_id> - STRING - postfix mail id
376 =item return
378 Nothing.
380 =back
382 =back
384 =cut
385 ###############################################################################
386 sub mailqueue_unhold {
387 my ($msg, $msg_hash) = @_;
388 my $header = @{$msg_hash->{'header'}}[0];
389 my $source = @{$msg_hash->{'source'}}[0];
390 my $target = @{$msg_hash->{'target'}}[0];
391 my $session_id = @{$msg_hash->{'session_id'}}[0];
392 my $error = 0;
393 my $error_string;
395 # sanity check of input
396 if (not exists $msg_hash->{'msg_id'}) {
397 $error_string = "Message doesn't contain a XML tag 'msg_id'";
398 &main::daemon_log("ERROR: $error_string : $msg", 1);
399 $error = 1;
400 } elsif (ref @{$msg_hash->{'msg_id'}}[0] eq "HASH") {
401 $error_string = "XML tag 'msg_id' is empty";
402 &main::daemon_log("ERROR: $error_string : $msg", 1);
403 $error = 1;
404 }
406 if (not $error) {
407 my @msg_ids = @{$msg_hash->{'msg_id'}};
408 foreach my $msg_id (@msg_ids) {
409 my $error = 0; # clear error status
411 # sanity check of each msg_id
412 if (not $msg_id =~ /^[0-9A-Z]{10,12}$/) {
413 $error = 1;
414 $error_string = "message ID is not valid ([0-9A-Z]{10,12}) : $msg_id";
415 &main::daemon_log("ERROR: $error_string : $msg", 1);
416 }
418 if (not $error) {
419 my $cmd = "/usr/sbin/postsuper -H $msg_id 2>&1";
420 &main::daemon_log("DEBUG: run $cmd\n", 7);
421 my $result = qx($cmd);
422 if ($result =~ /^postsuper: ([0-9A-Z]{10}): released from hold/ ) {
423 &main::daemon_log("INFO: Mail $msg_id released from on hold", 5);
424 } elsif ($result eq "") {
425 &main::daemon_log("INFO: Mail $msg_id is alread released from hold", 5);
427 } else {
428 &main::daemon_log("ERROR: '$cmd' failed : $result", 1);
429 }
431 }
432 }
433 }
435 return;
436 }
438 ###############################################################################
439 =over
441 =item B<mailqueue_requeue ($$)>
443 =over
445 =item description
447 Executes '/usr/sbin/postsuper -r' and requeue the mail.
449 =item parameter
451 $msg - STRING - complete GOsa-si message
452 $msg_hash - HASHREF - content of GOsa-si message in a hash
454 =item GOsa-si message xml content
456 <msg_id> - STRING - postfix mail id
458 =item return
460 Nothing.
462 =back
464 =back
466 =cut
467 ###############################################################################
468 sub mailqueue_requeue {
469 my ($msg, $msg_hash) = @_;
470 my $header = @{$msg_hash->{'header'}}[0];
471 my $source = @{$msg_hash->{'source'}}[0];
472 my $target = @{$msg_hash->{'target'}}[0];
473 my $session_id = @{$msg_hash->{'session_id'}}[0];
474 my @msg_ids = @{$msg_hash->{'msg_id'}};
475 my $error = 0;
476 my $error_string;
478 # sanity check of input
479 if (not exists $msg_hash->{'msg_id'}) {
480 $error_string = "Message doesn't contain a XML tag 'msg_id'";
481 &main::daemon_log("ERROR: $error_string : $msg", 1);
482 $error = 1;
483 } elsif (ref @{$msg_hash->{'msg_id'}}[0] eq "HASH") {
484 $error_string = "XML tag 'msg_id' is empty";
485 &main::daemon_log("ERROR: $error_string : $msg", 1);
486 $error = 1;
487 }
489 if (not $error) {
490 my @msg_ids = @{$msg_hash->{'msg_id'}};
491 foreach my $msg_id (@msg_ids) {
492 my $error = 0; # clear error status
494 # sanity check of each msg_id
495 if (not $msg_id =~ /^[0-9A-Z]{10,12}$/) {
496 $error = 1;
497 $error_string = "message ID is not valid ([0-9A-Z]{10,12}) : $msg_id";
498 &main::daemon_log("ERROR: $error_string : $msg", 1);
499 }
501 if (not $error) {
502 my $cmd = "/usr/sbin/postsuper -r $msg_id 2>&1";
503 &main::daemon_log("DEBUG: run '$cmd'", 7);
504 my $result = qx($cmd);
505 if ($result =~ /^postsuper: ([0-9A-Z]{10}): requeued/ ) {
506 &main::daemon_log("INFO: Mail $msg_id requeued", 5);
507 } elsif ($result eq "") {
508 &main::daemon_log("WARNING: Cannot requeue mail '$msg_id', mail not found!", 3);
510 } else {
511 &main::daemon_log("ERROR: '$cmd' failed : $result", 1);
512 }
514 }
515 }
516 }
518 return;
519 }
522 ###############################################################################
523 =over
525 =item B<mailqueue_del ($$)>
527 =over
529 =item description
531 Executes '/usr/sbin/postsuper -d' and deletes mail from queue.
533 =item parameter
535 $msg - STRING - complete GOsa-si message
536 $msg_hash - HASHREF - content of GOsa-si message in a hash
538 =item GOsa-si message xml content
540 <msg_id> - STRING - postfix mail id
542 =item return
544 Nothing.
546 =back
548 =back
550 =cut
551 ###############################################################################
552 sub mailqueue_del {
553 my ($msg, $msg_hash) = @_;
554 my $header = @{$msg_hash->{'header'}}[0];
555 my $source = @{$msg_hash->{'source'}}[0];
556 my $target = @{$msg_hash->{'target'}}[0];
557 my $session_id = @{$msg_hash->{'session_id'}}[0];
558 my @msg_ids = @{$msg_hash->{'msg_id'}};
559 my $error = 0;
560 my $error_string;
562 # sanity check of input
563 if (not exists $msg_hash->{'msg_id'}) {
564 $error_string = "Message doesn't contain a XML tag 'msg_id'";
565 &main::daemon_log("ERROR: $error_string : $msg", 1);
566 $error = 1;
567 } elsif (ref @{$msg_hash->{'msg_id'}}[0] eq "HASH") {
568 $error_string = "XML tag 'msg_id' is empty";
569 &main::daemon_log("ERROR: $error_string : $msg", 1);
570 $error = 1;
571 }
573 if (not $error) {
574 my @msg_ids = @{$msg_hash->{'msg_id'}};
575 foreach my $msg_id (@msg_ids) {
576 my $error = 0; # clear error status
578 # sanity check of each msg_id
579 if (not $msg_id =~ /^[0-9A-Z]{10,12}$/) {
580 $error = 1;
581 $error_string = "message ID is not valid ([0-9A-Z]{10,12}) : $msg_id";
582 &main::daemon_log("ERROR: $error_string : $msg", 1);
583 }
585 if (not $error) {
586 my $cmd = "/usr/sbin/postsuper -d $msg_id 2>&1";
587 &main::daemon_log("DEBUG: run '$cmd'", 7);
588 my $result = qx($cmd);
589 if ($result =~ /^postsuper: ([0-9A-Z]{10}): removed/ ) {
590 &main::daemon_log("INFO: Mail $msg_id deleted", 5);
591 } elsif ($result eq "") {
592 &main::daemon_log("WARNING: Cannot remove mail '$msg_id', mail not found!", 3);
594 } else {
595 &main::daemon_log("ERROR: '$cmd' failed : $result", 1);
596 }
598 }
599 }
600 }
602 return;
603 }
605 ###############################################################################
606 =over
608 =item B<mailqueue_header ($$)>
610 =over
612 =item description
614 Executes 'postcat -q', parse the informations and return them.
616 =item parameter
618 $msg - STRING - complete GOsa-si message
619 $msg_hash - HASHREF - content of GOsa-si message in a hash
621 =item GOsa-si message xml content
623 <msg_id> - STRING - postfix mail id
625 =item return
627 $out_msg - STRING - GOsa-si valid xml message containing recipient, sender and subject.
629 =back
631 =back
633 =cut
634 ###############################################################################
635 sub mailqueue_header {
636 my ($msg, $msg_hash) = @_;
637 my $header = @{$msg_hash->{'header'}}[0];
638 my $source = @{$msg_hash->{'source'}}[0];
639 my $target = @{$msg_hash->{'target'}}[0];
640 my $session_id = @{$msg_hash->{'session_id'}}[0];
641 my $error = 0;
642 my $error_string;
643 my $sender;
644 my $recipient;
645 my $subject;
646 my $out_hash;
647 my $out_msg;
649 # sanity check of input
650 if (not exists $msg_hash->{'msg_id'}) {
651 $error_string = "Message doesn't contain a XML tag 'msg_id'";
652 &main::daemon_log("ERROR: $error_string : $msg", 1);
653 $error = 1;
654 } elsif (ref @{$msg_hash->{'msg_id'}}[0] eq "HASH") {
655 $error_string = "XML tag 'msg_id' is empty";
656 &main::daemon_log("ERROR: $error_string : $msg", 1);
657 $error = 1;
658 }
660 # sanity check of each msg_id
661 my $msg_id;
662 if (not $error) {
663 $msg_id = @{$msg_hash->{'msg_id'}}[0];
664 if (not $msg_id =~ /^[0-9A-Z]{10,12}$/) {
665 $error = 1;
666 $error_string = "message ID is not valid ([0-9A-Z]{10,12}) : $msg_id";
667 &main::daemon_log("ERROR: $error_string : $msg", 1);
668 }
669 }
671 # parsing information
672 my $msg_header;
673 if (not $error) {
674 my $cmd = "postcat -q $msg_id";
675 &main::daemon_log("DEBUG: run '$cmd'", 7);
676 my $result = qx($cmd);
678 my @header_l = split(/\n\n/, $result);
679 $msg_header = $header_l[0];
680 }
682 # create outgoing msg
683 $out_hash = &main::create_xml_hash("answer_$session_id", $target, $source);
684 &add_content2xml_hash($out_hash, "session_id", $session_id);
685 &add_content2xml_hash($out_hash, "error", $error);
686 if (defined @{$msg_hash->{'forward_to_gosa'}}[0]){
687 &add_content2xml_hash($out_hash, "forward_to_gosa", @{$msg_hash->{'forward_to_gosa'}}[0]);
688 }
690 # add error infos to outgoing msg
691 if ($error) {
692 &add_content2xml_hash($out_hash, "error_string", $error_string);
693 $out_msg = &main::create_xml_string($out_hash);
695 # add mail infos to outgoing msg
696 } else {
697 #&add_content2xml_hash($out_hash, "msg_header", &decode_base64($msg_header));
698 &add_content2xml_hash($out_hash, "msg_header", $msg_header);
699 $out_msg = &main::create_xml_string($out_hash);
700 }
702 return $out_msg;
703 }
705 sub _exec_op {
706 my ($a, $op, $b) = @_ ;
707 my $res;
709 if ($op eq "eq") {
710 $res = $a =~ /$b/ ? 1 : 0 ;
711 } elsif ($op eq "gt") {
712 $res = $a > $b ? 1 : 0 ;
713 } elsif ($op eq "lt") {
714 $res = $a < $b ? 1 : 0 ;
715 }
717 return $res;
718 }
720 my $mo_hash = { "Jan"=>'01', "Feb"=>'02',"Mar"=>'03',"Apr"=>'04',"May"=>'05',"Jun"=>'06',
721 "Jul"=>'07',"Aug"=>'08',"Sep"=>'09',"Oct"=>'10',"Nov"=>'11',"Dec"=>'12'};
723 sub _parse_mailq_time {
724 my ($time) = @_ ;
726 my $local_time = &get_time();
727 my $local_year = substr($local_time,0,4);
729 my ($dow, $mo, $dd, $date) = split(/\s/, $time);
730 my ($hh, $mi, $ss) = split(/:/, $date);
731 my $mailq_time = $local_year.$mo_hash->{$mo}."$dd$hh$mi$ss";
733 # This is realy nasty
734 if (int($local_time) < int($mailq_time)) {
735 # Mailq_time is in the future, this cannot be possible, so mail must be from last year
736 $mailq_time = int($local_year) - 1 .$mo_hash->{$mo}."$dd$hh$mi$ss";
737 }
739 return $mailq_time;
740 }
742 # vim:ts=4:shiftwidth:expandtab
744 1;