EMDIS-ECS
view release on metacpan or search on metacpan
t/data/AA_01.msg
t/data/AA_01_32_47.msg
t/data/AA_02.msg
t/data/AA_03.doc
t/data/AA_meta.msg
t/data/AAA_01.msg
t/data/non_ecs.msg
t/data/non_ecs_2.msg
t/ecs.t
t/filebackedmessage.t
t/lockedhash.t
t/message.t
t/setup
web_status/README
web_status/ecs_status
web_status/ecs_status.pl
web_status/images/ecs_logo.ico
web_status/images/led_horiz_black.png
web_status/images/led_horiz_blue.png
web_status/images/led_horiz_green.png
web_status/images/led_horiz_grey.png
lib/EMDIS/ECS.pm view on Meta::CPAN
}
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;
lib/EMDIS/ECS.pm view on Meta::CPAN
@_);
}
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;
lib/EMDIS/ECS/FileBackedMessage.pm view on Meta::CPAN
$this->{filename} = $filename;
my $file_handle;
return "Unable to open input file $filename: $!"
unless open $file_handle, "+< $filename";
$this->{file_handle} = $file_handle;
binmode $file_handle;
# get exclusive lock (with retry loop)
# protects against reading a file while another process is writing it
my $locked = '';
for my $retry (1..5)
{
$locked = flock $file_handle, LOCK_EX | LOCK_NB;
last if $locked;
}
if(!$locked)
{
$err = "Unable to lock input file $filename: $!";
close $file_handle;
return $err;
}
my $email_headers = '';
my $data_offset = 0;
# attempt to read email headers only if sender_node_id not yet defined
lib/EMDIS/ECS/FileBackedMessage.pm view on Meta::CPAN
return "send_this_message(): ECS has not been configured."
unless ecs_is_configured();
my $cfg = $ECS_CFG;
my $node_tbl = $ECS_NODE_TBL;
my $err = '';
return "send_this_message(): Missing \$rcv_node_id!"
unless defined $rcv_node_id and $rcv_node_id;
# lock node_tbl, look up $rcv_node_id
my $was_locked = $node_tbl->LOCK;
if(not $was_locked)
{
$node_tbl->lock() # lock node_tbl
or return "send_this_message(): unable to lock node_tbl: " .
$node_tbl->ERROR;
}
my $node = $node_tbl->read($rcv_node_id);
if(not $node)
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): node not found: $rcv_node_id";
}
if(not $node->{addr})
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): addr not defined for node: $rcv_node_id";
}
# compute or assign message seq_num
my $seq_num = '';
if($is_re_send and not $this->{is_document})
{
# sanity checks
if(not defined $this->{seq_num})
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): seq_num not defined for RE_SEND";
}
if($this->{seq_num} > $node->{out_seq})
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): seq_num for RE_SEND (" .
$this->{seq_num} . ") is greater than out_seq for node " .
"$rcv_node_id (" . $node->{out_seq} . ")!";
}
$seq_num = $this->{seq_num};
}
elsif($is_re_send and $this->{is_document})
{
# sanity checks
if(not defined $this->{seq_num})
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): seq_num not defined for DOC_RE_SEND";
}
if($this->{seq_num} > $node->{doc_out_seq})
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): seq_num for DOC_RE_SEND (" .
$this->{seq_num} . ") is greater than doc_out_seq for node " .
"$rcv_node_id (" . $node->{doc_out_seq} . ")!";
}
$seq_num = $this->{seq_num};
}
elsif($this->{is_document})
{
# automatically get next (doc) sequence number
$node->{doc_out_seq}++;
$seq_num = $node->{doc_out_seq};
}
elsif(not $this->{is_meta_message})
{
# only allow $part_num to be specified if this is a RE_SEND request
if($part_num)
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): part_num specified ($part_num), for " .
"non- RE_SEND request!";
}
# automatically get next (msg) sequence number
$node->{out_seq}++;
$seq_num = $node->{out_seq};
}
# compute message part size
my $msg_part_size = $cfg->MSG_PART_SIZE_DFLT;
if(defined $node->{msg_part_size} and $node->{msg_part_size} > 0)
{
$msg_part_size = $node->{msg_part_size};
}
# compute data size
my $file_size = (stat $this->{file_handle})[7];
my $data_size = $file_size - $this->{data_offset};
if($data_size <= 0)
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): data_size is <= 0 ($data_size)!";
}
# for document, force num_parts = 1
if($this->{is_document})
{
$msg_part_size = $data_size;
}
# compute num_parts
my $num_parts = int($data_size / $msg_part_size);
$num_parts++ if ($data_size % $msg_part_size) > 0;
# num_parts should be 1 for meta message
if($this->{is_meta_message} and $num_parts > 1)
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): num_parts cannot be > 1 for meta message!";
}
# $part_num cannot be greater than $num_parts
if(defined $part_num and $part_num and $part_num > $num_parts)
{
$node_tbl->unlock() unless $was_locked; # unlock node_tbl if needed
return "send_this_message(): part_num ($part_num) cannot be greater " .
"than num_parts ($num_parts)!";
}
# compute base subject
my $subject = $cfg->MAIL_MRK . ':' . $cfg->THIS_NODE;
$subject .= ":$seq_num" if $seq_num;
$subject .= ":DOC" if $this->{is_document};
if($is_re_send)
lib/EMDIS/ECS/FileBackedMessage.pm view on Meta::CPAN
print $fh "From: " . $cfg->SMTP_FROM . "\n\n";
# copy data to $fh
$err = "Unable to position file pointer for file $this->{filename}" .
" to position $this->{data_offset}: $!"
unless seek $this->{file_handle}, $this->{data_offset}, 0;
my $buffer;
while(1)
{
if($err)
{
$node_tbl->unlock() unless $was_locked; # unlock if needed
close $fh;
unlink $filename;
return $err;
}
my $bytecount = read $this->{file_handle}, $buffer, 65536;
if(not defined $bytecount)
{
$err = "send_this_message(): Problem reading input file " .
"$this->{filename}: $!";
lib/EMDIS/ECS/FileBackedMessage.pm view on Meta::CPAN
}
if(not $err)
{
# update node last_out, possibly out_seq
$node->{last_out} = time();
$err = $node_tbl->ERROR
unless $node_tbl->write($rcv_node_id, $node);
}
$node_tbl->unlock() # unlock node_tbl if needed
unless $was_locked;
return $err;
}
1;
__DATA__
# embedded POD documentation
# for more info: man perlpod
lib/EMDIS/ECS/LockedHash.pm view on Meta::CPAN
sub ERROR {
my $this = shift;
my $err = shift;
if(defined $err) {
$this->{ERROR} = $err;
}
return $this->{ERROR};
}
# ----------------------------------------------------------------------
# set/get locked status indicator
sub LOCK {
my $this = shift;
my $status = shift;
if(defined $status) {
$this->{LOCK} = $status;
}
return $this->{LOCK};
}
# ----------------------------------------------------------------------
lib/EMDIS/ECS/LockedHash.pm view on Meta::CPAN
}
# ----------------------------------------------------------------------
# Obtain (advisory) lock and tie internal hash to db file.
sub lock {
my $this = shift;
my $lock_type = shift;
my $oldlock = $this->LOCK;
$lock_type = LOCK_EX unless $lock_type; # default = LOCK_EX
$this->ERROR(''); # reset error status
return 1 if $oldlock == $lock_type; # already locked
my $locked = 0;
my $attempt = 0;
while(!$locked and $attempt++ < 5) {
sleep 2 if $attempt > 1;
$this->ERROR(''); # reset error status
$locked = $this->_lock($lock_type);
}
if(!$locked) {
$this->ERROR("EMDIS::ECS::LockedHash::lock() failed: " . $this->ERROR);
return '';
}
if(!$this->TIED and !$this->_tie()) {
$this->ERROR("EMDIS::ECS::LockedHash::lock() failed: " . $this->ERROR);
return '';
}
return 1; # successful
}
lib/EMDIS/ECS/LockedHash.pm view on Meta::CPAN
sub _lock_win32 {
my $this = shift;
my $lock_type = shift;
$lock_type = LOCK_EX unless defined $lock_type;
my $result = 1;
# attempt to obtain lock, with time limit
# (uses polling method to obtain lock -- somewhat more crude than
# the unix method, which uses blocking with SIGALRM to enforce timeout)
my $timeoutCount = 0;
my $locked;
while (!($locked = flock($this->{FH_LOCK}, $lock_type | LOCK_NB)) and
($timeoutCount++ <= $this->{lock_timeout})) {
sleep 1;
}
if(!$locked) {
$this->ERROR("EMDIS::ECS::LockedHash::_lock_win32() failed: $@");
$this->LOCK(0); # reset status indicator
$result = '';
}
$this->LOCK($lock_type) # set status indicator
if $result;
return $result; # successful
}
# ----------------------------------------------------------------------
lib/EMDIS/ECS/Message.pm view on Meta::CPAN
$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 {
script/ecs_scan_mail view on Meta::CPAN
}
my $err = $msg->inspect_fml();
if($err)
{
log_error("process_maildrop(): unable to inspect FML in " .
"$filename: $err");
last; # don't continue
}
# retrieve node status from node_tbl
my $was_locked = $ECS_NODE_TBL->LOCK;
if(not $was_locked)
{
# lock ECS_NODE_TBL
if(not $ECS_NODE_TBL->lock())
{
log_error("process_maildrop(): unable to lock ECS_NODE_TBL: " .
$ECS_NODE_TBL->ERROR);
last;
}
}
my $node = $ECS_NODE_TBL->read($msg->hub_rcv);
$ECS_NODE_TBL->unlock() unless $was_locked;
if (not defined $node) {
log_error("process_maildrop(): cannot read node '" . $msg->hub_rcv . "'");
next;
}
# don't process the message, if the receiving node is disabled
if (not ( (exists $node->{node_disabled}) and
is_yes($node->{node_disabled}) ) )
{
script/ecs_scan_mail view on Meta::CPAN
push @nodelist, $node_id;
}
}
# iterate through nodes and
# check whether any of the messages are able to be processed
NODE:
for my $node_id (@nodelist)
{
# retrieve node status from node_tbl
my $was_locked = $ECS_NODE_TBL->LOCK;
if(not $was_locked)
{
# lock ECS_NODE_TBL
if(not $ECS_NODE_TBL->lock())
{
log_error("process_store(): unable to lock ECS_NODE_TBL: " .
$ECS_NODE_TBL->ERROR);
last NODE;
}
}
my $node = $ECS_NODE_TBL->read($node_id);
$ECS_NODE_TBL->unlock() unless $was_locked;
# don't try to process if node not found
if(not ref $node)
{
log_error(
"process_store(): unable to retrieve node $node_id status.");
next NODE;
}
# is node marked as disabled?
if((exists $node->{node_disabled}) and
is_yes($node->{node_disabled}))
script/ecs_scan_mail view on Meta::CPAN
}
$q_doc_gap_time = time();
}
}
else
{
$q_doc_gap_seq = $seq_num;
$q_doc_gap_time = time();
}
# update q_doc_gap_seq and q_doc_gap_time in node_tbl
my $was_locked = $ECS_NODE_TBL->LOCK;
if(not $was_locked)
{
if(not $ECS_NODE_TBL->lock())
{
log_error("process_store(): unable to lock " .
"ECS_NODE_TBL: " . $ECS_NODE_TBL->ERROR);
}
}
if($ECS_NODE_TBL->LOCK)
{
my $node = $ECS_NODE_TBL->read($node_id);
$node->{q_doc_gap_seq} = $q_doc_gap_seq;
$node->{q_doc_gap_time} = $q_doc_gap_time;
$ECS_NODE_TBL->write($node_id, $node);
$ECS_NODE_TBL->unlock() unless $was_locked;
}
last NODE_DOC_MSG_PART;
}
# sanity check - docnumparts should always be 1
if($nodes->{$node_id}->{docnumparts}->{$seq_num} != 1) {
log_error("process_store(): unexpected error, document parts > 1 " .
"for $node_id:$seq_num:DOC");
last NODE_DOC_MSG_PART;
}
script/ecs_scan_mail view on Meta::CPAN
}
$q_gap_time = time();
}
}
else
{
$q_gap_seq = $seq_num;
$q_gap_time = time();
}
# update q_gap_seq and q_gap time in node_tbl
my $was_locked = $ECS_NODE_TBL->LOCK;
if(not $was_locked)
{
if(not $ECS_NODE_TBL->lock())
{
log_error("process_store(): unable to lock " .
"ECS_NODE_TBL: " . $ECS_NODE_TBL->ERROR);
}
}
if($ECS_NODE_TBL->LOCK)
{
my $node = $ECS_NODE_TBL->read($node_id);
$node->{q_gap_seq} = $q_gap_seq;
$node->{q_gap_time} = $q_gap_time;
$ECS_NODE_TBL->write($node_id, $node);
$ECS_NODE_TBL->unlock() unless $was_locked;
}
last NODE_MSG_PART;
}
# assemble message part file name array, and
# determine whether all message parts are present
my @msg_part_filenames = ();
my @missing_parts = ();
for my $pn (1..$nodes->{$node_id}->{numparts}->{$seq_num})
{
script/ecs_scan_mail view on Meta::CPAN
}
$q_gap_time = time();
}
}
else
{
$q_gap_seq = $seq_num;
$q_gap_time = time();
}
# update q_gap_seq and q_gap time in node_tbl
my $was_locked = $ECS_NODE_TBL->LOCK;
if(not $was_locked)
{
if(not $ECS_NODE_TBL->lock())
{
log_error("process_store(): unable to lock " .
"ECS_NODE_TBL: " . $ECS_NODE_TBL->ERROR);
}
}
if($ECS_NODE_TBL->LOCK)
{
my $node = $ECS_NODE_TBL->read($node_id);
$node->{q_gap_seq} = $q_gap_seq;
$node->{q_gap_time} = $q_gap_time;
$ECS_NODE_TBL->write($node_id, $node);
$ECS_NODE_TBL->unlock() unless $was_locked;
}
last NODE_MSG_PART;
}
# process message
my $filename = $msgpart->{$seq_part_num};
print "$DEBUG_LABEL processing \"store\" file: $filename\n"
if $ECS_CFG->{ECS_DEBUG} > 0;
my $msg = EMDIS::ECS::Message::read_from_file($filename);
script/ecs_scan_mail view on Meta::CPAN
{
my $msg = shift;
my $filename = shift;
my $decrypt = shift;
my $err = '';
print "$DEBUG_LABEL process_document(\$msg, $filename, $decrypt)\n"
if $ECS_CFG->ECS_DEBUG > 0;
# look up node in ECS_NODE_TBL
my $was_locked = $ECS_NODE_TBL->LOCK;
if(not $was_locked) {
# lock ECS_NODE_TBL
return "process_document(): unable to lock ECS_NODE_TBL: " .
$ECS_NODE_TBL->ERROR
unless $ECS_NODE_TBL->lock();
}
# store information about document currently being processed
my $this_node = $ECS_NODE_TBL->read($ECS_CFG->THIS_NODE);
$this_node->{proc_node} = $msg->sender;
$this_node->{proc_seq} = $msg->seq_num;
$this_node->{proc_file} = $filename;
$ECS_NODE_TBL->write($ECS_CFG->THIS_NODE, $this_node);
# retrieve node info
my $node = $ECS_NODE_TBL->read($msg->sender);
$ECS_NODE_TBL->unlock() unless $was_locked; # release node_tbl lock
if(not $node) {
# don't process message from unknown node
$err = "process_document(): $err; " . EOL()
if $err;
$err .= "process_document(): document from unknown node: " .
$msg->sender;
return $err;
}
# don't process "duplicate" document (seq_num too low)
script/ecs_scan_mail view on Meta::CPAN
# remove temp file
unlink $doc_fname;
return $err if $err ne '';
unlink $filename; # remove input file after successful processing
# message was processed
# if needed, update $node->{doc_in_seq}
if(not $was_locked) {
$ECS_NODE_TBL->lock() # lock ECS_NODE_TBL if needed
or return "process_document(): unable to (write) lock " .
"ECS_NODE_TBL: " . $ECS_NODE_TBL->ERROR;
}
$node = $ECS_NODE_TBL->read($msg->sender);
$err = $ECS_NODE_TBL->ERROR;
if((not $err) and (ref $node))
{
$node->{doc_in_seq}++;
if($msg->seq_num == $node->{doc_in_seq})
script/ecs_scan_mail view on Meta::CPAN
}
else
{
$node->{doc_in_seq_ack} = $node->{doc_in_seq};
}
}
$ECS_NODE_TBL->write($msg->sender,$node);
$err = $ECS_NODE_TBL->ERROR;
}
}
$ECS_NODE_TBL->unlock() unless $was_locked; # release node_tbl lock
return "process_document(): $err" if $err;
return '';
}
# ----------------------------------------------------------------------
# Process specified meta-message.
# returns error message, if any
sub process_meta_message
{
script/ecs_scan_mail view on Meta::CPAN
my $msg_part_filenames = shift;
my $err = '';
my @msgs = ();
my $child_pid;
print "$DEBUG_LABEL process_message(\$msg, $filename, $decrypt, (" .
join(', ', @$msg_part_filenames) . "))\n"
if $ECS_CFG->ECS_DEBUG > 0;
# look up node in ECS_NODE_TBL
my $was_locked = $ECS_NODE_TBL->LOCK;
if(not $was_locked) {
# lock ECS_NODE_TBL
return "process_message(): unable to lock ECS_NODE_TBL: " .
$ECS_NODE_TBL->ERROR
unless $ECS_NODE_TBL->lock();
}
# store information about message currently being processed
my $this_node = $ECS_NODE_TBL->read($ECS_CFG->THIS_NODE);
$this_node->{proc_node} = $msg->sender;
$this_node->{proc_seq} = $msg->seq_num;
$this_node->{proc_file} = $filename;
$ECS_NODE_TBL->write($ECS_CFG->THIS_NODE, $this_node);
# retrieve node info
my $node = $ECS_NODE_TBL->read($msg->sender);
$ECS_NODE_TBL->unlock() unless $was_locked; # release node_tbl lock
if(not $node) {
# don't process message from unknown node
$err = "process_message(): $err; " . EOL()
if $err;
$err .= "process_message(): message from unknown node: " .
$msg->sender;
return $err;
}
# don't process "duplicate" message (seq_num too low)
script/ecs_scan_mail view on Meta::CPAN
chmod $EMDIS::ECS::FILEMODE, $from_filename;
}
# remove temp file
unlink $payload_filename;
return $err if $err ne '';
# message was processed
# if needed, update $node->{in_seq}
if(not $was_locked) {
$ECS_NODE_TBL->lock() # lock ECS_NODE_TBL if needed
or return "process_message(): unable to (write) lock " .
"ECS_NODE_TBL: " . $ECS_NODE_TBL->ERROR;
}
$node = $ECS_NODE_TBL->read($msg->sender);
$err = $ECS_NODE_TBL->ERROR;
if((not $err) and (ref $node))
{
$node->{in_seq}++;
if($msg->seq_num == $node->{in_seq})
script/ecs_scan_mail view on Meta::CPAN
}
else
{
$node->{in_seq_ack} = $node->{in_seq};
}
}
$ECS_NODE_TBL->write($msg->sender,$node);
$err = $ECS_NODE_TBL->ERROR;
}
}
$ECS_NODE_TBL->unlock() unless $was_locked; # release node_tbl lock
return "process_message(): $err" if $err;
return '';
}
# ----------------------------------------------------------------------
# Re-read configuration when SIGHUP received.
sub sighup_handler
{
$reload_config = 1;
( run in 0.711 second using v1.01-cache-2.11-cpan-49f99fa48dc )