view release on metacpan or  search on metacpan

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

    my ($filename,$raw_text,$this);
    if(ref $arg1) {
        # invoked as instance method
        $this = $arg1;
        $filename = shift;
    }
    else {
        # invoked as class method
        $filename = $arg1;
    }

    # read file
    open(MSGFILE, "< $filename")
        or return "Unable to open file $filename: $!";
    $raw_text = join('', <MSGFILE>)
        or $err = "Unable to read file $filename: $!";
    close MSGFILE;
    return $err if $err;  # return error message (if any)

    # attempt to construct object
    my $newmsg;
    if(ref $arg1) {
        $newmsg = $this->new($raw_text);  # re-define this object
    }
    else {
        $newmsg = new EMDIS::ECS::Message($raw_text);
    }

    # set 'cleartext' attribute of message object
    $newmsg->{cleartext} = $newmsg->{body}
        if ref $newmsg;

    return $newmsg;
}

# ----------------------------------------------------------------------
# read and decrypt message from encrypted file
# returns object reference if successful, otherwise returns error message
sub read_from_encrypted_file
{
    my $err = '';
    my $arg1 = shift;
    my ($filename,$raw_text,$this);
    if(ref $arg1) {
        # invoked as instance method
        $this = $arg1;
        $filename = shift;
    }
    else {
        # invoked as class method
        $filename = $arg1;
    }

    # read encrypted file
    my $newmsg = read_from_file($filename);
    return $newmsg unless ref $newmsg;   # check for error
    return "not an ECS message" unless $newmsg->is_ecs_message or $newmsg->is_document;

    # read relevant node info from node_tbl
    my $node_tbl = $main::ECS_NODE_TBL;
    my $was_locked = $node_tbl->LOCK;
    if(not $was_locked) {
        $node_tbl->lock()     # lock node_tbl
            or return "unable to lock node_tbl: " .
                $node_tbl->ERROR;
    }
    my $node = $node_tbl->read($newmsg->sender);
    if(not $was_locked) {
        $node_tbl->unlock();  # unlock node_tbl
    }
    if(not $node) {
        return "node not found: " . $newmsg->sender;
    }

    # decrypt message into temp file
    my $decr_filename = "$filename.asc";
    for ($node->{encr_typ}) {
        /PGP2/i and do {
            $err = pgp2_decrypt(
                $filename,
                $decr_filename,
                (/verify/i ? $node->{encr_sig} : undef),
                $node->{encr_out_passphrase});
            last;
        };
        /OpenPGP/i and do {
            $err = openpgp_decrypt(
                $filename,
                $decr_filename,
                (/verify/i ? $node->{encr_sig} : undef),
                $node->{encr_out_passphrase});
            last;
        };
        $err = "unrecognized encr_typ: $node->{encr_typ}\n";
    }
    if($err) {
        unlink $decr_filename;
        chomp($err);
        return $err;
    }

    # read message cleartext from temp file
    my $fh = new IO::File;
    return "unable to open file: $decr_filename"
        unless $fh->open("< $decr_filename");
    my @cleartext = $fh->getlines();
    close $fh;

    # remove temp file
    unlink $decr_filename;

    # set 'cleartext' message attribute
    $newmsg->{cleartext} = join('', @cleartext);

    return $newmsg;
}


1;

__DATA__

# embedded POD documentation
# for more info:  man perlpod

=head1 NAME

EMDIS::ECS::Message - an ECS email message