view release on metacpan or  search on metacpan

lib/EMDIS/ECS.pm  view on Meta::CPAN

        my @recipients = split /,/, $cfg->ADM_ADDR;
        foreach my $recipient (@recipients)
        {
            $err = send_email($recipient, '[' . $cfg->MAIL_MRK . '] ECS Error',
                undef, "Origin: $0\n", @_);

            log_error("Unable to send admin email to $recipient: $err")
                if $err and $_[$#_] !~ /Unable to send admin email/iso;
        }
    }

    return $err;
}

# ----------------------------------------------------------------------
# Send ECS email message.
# Returns empty string if successful or error message if error encountered.
sub send_ecs_message {
    my $node_id = shift;
    my $seq_num = shift;
    # @_ now contains message body

    # initialize
    return "EMDIS::ECS::send_ecs_message(): ECS has not been configured."
        unless ecs_is_configured();
    my $cfg = $ECS_CFG;
    my $node_tbl = $ECS_NODE_TBL;
    my $err = '';

    # do some validation
    my ($hub_rcv, $hub_snd);
    if($seq_num && !$node_id) {
        # parse FML to determing $node_id:
        # do some cursory validation, extract HUB_RCV and HUB_SND
        my $fml = join('', @_);
        return "EMDIS::ECS::send_ecs_message(): message does not contain valid FML"
                unless $fml =~ /^.+:.+;/s;
        if($fml =~ /HUB_RCV\s*=\s*([^,;]+)/is) {  # presumes [^,;] in HUB_RCV
            $hub_rcv = dequote(trim($1));
        }
        else {
            return "EMDIS::ECS::send_ecs_message(): message does not specify " .
                "HUB_RCV";
        }
        if($fml =~ /HUB_SND\s*=\s*([^,;]+)/is) {  # presumes [^,;] in HUB_SND
            $hub_snd = dequote(trim($1));
        }
        else {
            return "EMDIS::ECS::send_ecs_message(): message does not specify " .
                "HUB_SND";
        }
        return "EMDIS::ECS::send_ecs_message(): HUB_SND is incorrect: $hub_snd"
            unless $hub_snd eq $ECS_CFG->THIS_NODE;
        $node_id = $hub_rcv unless $node_id;
        return "EMDIS::ECS::send_ecs_message(): node_id ($node_id) and FML " .
            "HUB_RCV ($hub_rcv) do not match"
            unless $node_id eq $hub_rcv;
    }

    # look up specified node in node_tbl
    my $was_locked = $node_tbl->LOCK;
    if(not $was_locked) {
        $node_tbl->lock()     # lock node_tbl if needed
            or return "EMDIS::ECS::send_ecs_message(): unable to lock node_tbl: " .
                $node_tbl->ERROR;
    }
    my $node = $node_tbl->read($node_id);
    if(not $node) {
        $node_tbl->unlock() unless $was_locked;  # unlock node_tbl if needed
        return "EMDIS::ECS::send_ecs_message(): node not found: " . $node_id;
    }
    if(not $node->{addr}) {
        $node_tbl->unlock() unless $was_locked;  # unlock node_tbl if needed
        return "EMDIS::ECS::send_ecs_message(): addr not defined for node: $node_id";
    }
    if($seq_num =~ /auto/i) {
        # automatically get next sequence number
        $node->{out_seq}++;
        $seq_num = $node->{out_seq};
    }

    my $subject = $cfg->MAIL_MRK . ':' . $cfg->THIS_NODE;
    $subject .= ":$seq_num" if $seq_num;

    my $filename;

    # if not meta-message, copy to mboxes/out_NODE subdirectory
    if($seq_num) {
        $filename = format_msg_filename($node_id,$seq_num);
        # create directory if it doesn't already exist
        my $dirname = dirname($filename);
        mkdir $dirname unless -e $dirname;
     }
     else { 
        # if meta-message, copy to mboxes/out subdirectory
        $filename = sprintf("%s_%s_%s.msg",
                       $cfg->THIS_NODE, $node_id, "META");
        my $dirname = $cfg->ECS_MBX_OUT_DIR; 
        # create directory if it doesn't already exist
        mkdir $dirname unless -e $dirname;
        $filename = catfile($dirname, $filename);
     }

     # don't overwrite $filename file if it already exists
     my $fh;
     if(-e $filename) {
         my $template = $filename . "_XXXX";
         ($fh, $filename) = tempfile($template);
         return "EMDIS::ECS::send_ecs_message(): unable to open _XXXX file: " .
             "$filename"
                 unless $fh;
     }
     else {
         $fh = new IO::File;
         return "EMDIS::ECS::send_ecs_message(): unable to open file: " .
             "$filename"
                 unless $fh->open("> $filename");
     }

     $fh->print("Subject: $subject\n");
     $fh->print("To: $node->{addr}\n");
     $fh->print("From: " . $cfg->SMTP_FROM . "\n\n");
     $fh->print(@_);
     $fh->close();
     chmod $FILEMODE, $filename;

    if ( $err ) {
        $err = "EMDIS::ECS::send_ecs_message(): unable to update node $node_id: $err";
    }
    elsif ( not $seq_num and ($node->{encr_meta} !~ /true/i) ) {
        # if indicated, don't encrypt meta-message
        if(is_yes($cfg->ENABLE_AMQP) and exists $node->{amqp_addr_meta} and $node->{amqp_addr_meta}) {
            # send meta-message via AMQP (if indicated by node config)
            $err = send_amqp_message(
                $node->{amqp_addr_meta},
                $subject,
                $node,
                undef,
                @_);
        }
        elsif(is_yes($node->{amqp_only})) {
            $err = "EMDIS::ECS::send_ecs_message(): unable to send " .
                "email META message to node " . $node->{node} .
                ": amqp_only selected.";
        }
        else {
            $err = send_email($node->{addr}, $subject, undef, @_);
        }
    }
    else {
        # otherwise, send encrypted message
        $err = send_encrypted_message(
            $node->{encr_typ},
            $node->{addr_r},
            $node->{addr},
            $node->{encr_out_keyid},
            $node->{encr_out_passphrase},
            $node,
            $subject,
            undef,
            @_);
    }

    if ( ! $err ) {
        # update node last_out, possibly out_seq
        $node->{last_out} = time();
        $err = $node_tbl->ERROR
            unless $node_tbl->write($node_id, $node);
    }
    $node_tbl->unlock()  # unlock node_tbl
        unless $was_locked;

    return $err;
}

# ----------------------------------------------------------------------
# Send email message.  Takes four or more arguments: the recipient,
# subject line, custom headers (hash ref), and body lines to be emailed.
# Returns empty string if successful or error message if error encountered.
sub send_email {
    my $recipient = shift;
    my $subject = shift;
    my $custom_headers = shift;
    # @_ now contains message body

    return "EMDIS::ECS::send_email(): ECS has not been configured."
        unless ecs_is_configured();
    my $cfg = $ECS_CFG;

    return "EMDIS::ECS::send_email(): custom_headers must be undef or HASH ref (found " .
        ref($custom_headers) . ")"
        if defined $custom_headers and not 'HASH' eq ref $custom_headers;

    my $smtp;
    if(is_yes($cfg->SMTP_USE_SSL) or is_yes($cfg->SMTP_USE_STARTTLS)) {
        return "To use SSL or TLS please install Net::SMTP with version >= 3.05"
            if CPAN::Version->vlt($Net::SMTP::VERSION, '3.05');
    }
    if(is_yes($cfg->SMTP_USE_SSL)) {
        $smtp = Net::SMTP->new($cfg->SMTP_HOST,
                              Hello   => $cfg->SMTP_DOMAIN,
                              Timeout => $cfg->SMTP_TIMEOUT,
                              Debug   => $cfg->SMTP_DEBUG,
                              Port    => $cfg->SMTP_PORT,
                              SSL     => 1)
        or return "Unable to open SMTP connection to " .
            $cfg->SMTP_HOST . ": $@";
    }
    else {
        $smtp = Net::SMTP->new($cfg->SMTP_HOST,
                              Hello   => $cfg->SMTP_DOMAIN,
                              Timeout => $cfg->SMTP_TIMEOUT,
                              Debug   => $cfg->SMTP_DEBUG,
                              Port    => $cfg->SMTP_PORT)
        or return "Unable to open SMTP connection to " .
            $cfg->SMTP_HOST . ": $@";
        if(is_yes($cfg->SMTP_USE_STARTTLS)) {
            if(not $smtp->starttls()) {
                my $err = "STARTTLS failed:  " . $smtp->message();
                $smtp->quit();
                return $err;
            }
        }
    }
    if($cfg->SMTP_OAUTH_TOKEN_CMD) {
        if(!is_yes($ECS_CFG->SMTP_USE_SSL) and !is_yes($ECS_CFG->SMTP_USE_STARTTLS)) {
            $smtp->quit();
            return "Unable to use SMTP SASL OAuth authentication without SSL/TLS.";
        }

        return "To use SASL authentication mechanisms XOAUTH2 or OAUTHBEARER " .