FTN-Outbound-BSO
view release on metacpan or search on metacpan
lib/FTN/Outbound/BSO.pm view on Meta::CPAN
direct => [ qw/ dut dlo / ],
normal => [ qw/ out flo / ],
hold => [ qw/ hut hlo / ],
);
# Reference files consist of a number of lines (terminated by 0x0a or 0x0d,0x0a) each consisting of the name of the file to transfer to the remote system.
# file_type => extension. both keys and values should be unique in their sets
# content notes are from fts-5005.003
my %control_file_extension = ( file_request => 'req', # file requests
# The format of request files is documented in FTS-0006.
busy => 'bsy', # busy control file.
# may contain one line of PID information (less than 70 characters).
call => 'csy', # call control file
# may contain one line of PID information (less than 70 characters).
hold => 'hld', # hold control file
# must contain a one line string with the expiration of the hold period expressed in UNIX-time.
try => 'try', # try control file
# A try file (if implemented by a mailer) must contain the following:
# NOK - Number of good connects, expressed as a 16-bit, big-endian integer.
# NBAD - Number of bad connects, expressed as a 16-bit, big-endian integer.
lib/FTN/Outbound/BSO.pm view on Meta::CPAN
);
open my $fh, '>>', $flo
or die sprintf 'cannot open %s: %s', $flo, $!;
print $fh '';
close $fh;
}
$bso -> busy_protected_sub( $addr,
\ &poll,
);
=head1 DESCRIPTION
FTN::Outbound::BSO module is for working with BinkleyTerm Style Outbound in FTN following specifications from fts-5005.003 document. Figuring out correct file to process might be a tricky process: different casing, few our main domains, other differ...
=head1 OBJECT CREATION
=head2 new
lib/FTN/Outbound/BSO.pm view on Meta::CPAN
domain - domain part of our address as described in frl-1028.002.
zone - our zone in that domain
At least one of the ways should be provided. In case both are our_addr has higher priority.
domain_abbrev - hash reference where keys are known domains and values are directory names (without extension) in outbound_root for those domains. Mandatory parameter.
reference_file_read_line_transform_sub - reference to a function that receives an octet string and returns a character string. Will be passed to FTN::Outbound::Reference_file constructor. If not provided reference file content won't be processed.
maximum_session_time - maximum session time in seconds. If provided, all found busy files older than 2 * value will be removed during outbound scan.
Returns newly created object on success.
=cut
sub new {
my $logger = Log::Log4perl -> get_logger( __PACKAGE__ );
ref( my $class = shift ) and $logger -> logcroak( "I'm only a class method!" );
lib/FTN/Outbound/BSO.pm view on Meta::CPAN
$self -> {reference_file_read_line_transform_sub},
)
-> read_existing_file
-> referenced_files;
}
push @{ $target -> { $net }{ $node }{ $point }{reference_file}{ $flavour } },
$file_prop;
} elsif ( exists $ext_control_file{ $lc_ext } ) {
my $age = $file_prop -> {mstat} ? time - $file_prop -> {mstat} : 0;
if ( $ext_control_file{ $lc_ext } eq 'busy'
&& exists $self -> {maximum_session_time}
&& $self -> {maximum_session_time} * 2 < $age
) { # try to remove if maximum_session_time is defined and busy is older than it
$logger -> info( sprintf 'removing expired busy %s (%d seconds old)',
$file_prop -> {full_name},
$age,
);
unlink Encode::encode( locale_fs => $file_prop -> {full_name} )
or $logger -> logdie( sprintf 'could not unlink %s: %s',
$file_prop -> {full_name},
$!,
);
} else {
push @{ $target -> { $net }{ $node }{ $point }{ $ext_control_file{ $lc_ext } } },
$file_prop;
}
}
}
=head1 OBJECT METHODS
=head2 scan
Scans outbound for all known domains. Old busy files might be removed.
Returns itself for chaining.
=cut
sub scan {
my $logger = Log::Log4perl -> get_logger( __PACKAGE__ );
ref( my $self = shift ) or $logger -> logcroak( "I'm only an object method!" );
lib/FTN/Outbound/BSO.pm view on Meta::CPAN
&& $addr -> isa( 'FTN::Addr' );
$logger -> logdie( 'passed address has unknown domain: %s',
$addr -> domain,
)
unless exists $self -> {domain_abbrev}{ $addr -> domain };
$addr;
}
=head2 is_busy
Expects one parameter - address as FTN::Addr object. Returns true if that address is busy (connection session, mail processing, ...).
=cut
sub is_busy {
my $logger = Log::Log4perl -> get_logger( __PACKAGE__ );
ref( my $self = shift ) or $logger -> logcroak( "I'm only an object method!" );
my $addr = $self -> _validate_addr( shift );
$self -> scan
unless exists $self -> {scanned};
exists $self -> {scanned}{ $addr -> domain }
&& exists $self -> {scanned}{ $addr -> domain }{ $addr -> zone }
&& grep { exists $self -> {scanned}{ $addr -> domain }{ $addr -> zone }{ $_ }{ $addr -> net }
&& exists $self -> {scanned}{ $addr -> domain }{ $addr -> zone }{ $_ }{ $addr -> net }{ $addr -> node }
&& exists $self -> {scanned}{ $addr -> domain }{ $addr -> zone }{ $_ }{ $addr -> net }{ $addr -> node }{ $addr -> point }
&& exists $self -> {scanned}{ $addr -> domain }{ $addr -> zone }{ $_ }{ $addr -> net }{ $addr -> node }{ $addr -> point }{busy}
} keys %{ $self -> {scanned}{ $addr -> domain }{ $addr -> zone } };
}
sub _select_domain_zone_dir { # best one. for updating. for checking needs a list (another method or direct access to the structure)
# and makes one if it doesn't exist or isn't good enough (e.g. our_domain_abbr.our_zone)
my $logger = Log::Log4perl -> get_logger( __PACKAGE__ );
ref( my $self = shift ) or $logger -> logcroak( "I'm only an object method!" );
my $domain = shift;
lib/FTN/Outbound/BSO.pm view on Meta::CPAN
$!,
);
$self -> {scanned}{ $domain }{ $zone }{ $dz_out }{ $net }{ $node }{points_dir}{ $points_dir } = $dir_full_name;
}
# return ( dz_out, $points_dir) or full points directory path?
$self -> {scanned}{ $domain }{ $zone }{ $dz_out }{ $net }{ $node }{points_dir}{ $points_dir };
}
=head2 busy_protected_sub
Expects two parameters:
address going to be dealt with as a FTN::Addr object
function reference that will receive passed address and us ($self) as parameters and which should do all required operations related to the passed address.
This method infinitely waits (most likely will be changed in the future) until address is not busy. Then it creates busy flag and calls passed function reference providing itself as an argument for it. After function return removes created busy fla...
Returns itself for chaining.
=cut
sub busy_protected_sub { # address, sub_ref( self ). (order busy, execute sub, remove busy)
my $logger = Log::Log4perl -> get_logger( __PACKAGE__ );
ref( my $self = shift ) or $logger -> logcroak( "I'm only an object method!" );
my $addr = $self -> _validate_addr( shift );
$logger -> logdie( 'no valid sub_ref passed' )
unless @_
&& defined $_[ 0 ]
&& 'CODE' eq ref $_[ 0 ];
my $sub_ref = shift;
$self -> scan
unless exists $self -> {scanned};
# check that it's not already busy
while ( $self -> is_busy( $addr ) ) {
sleep( 4 ); # waiting...
$self -> scan;
}
# here there is no busy flag for passed address. make it in the best dir then
my $busy_name;
if ( $addr -> point ) { # possible dir creation
$busy_name = File::Spec -> catfile( $self -> _select_points_dir( $addr -> domain,
$addr -> zone,
$addr -> net,
$addr -> node,
),
sprintf( '%08x',
$addr -> point,
),
);
} else {
my $dz_out = $self -> _select_domain_zone_dir( $addr -> domain,
$addr -> zone,
);
$busy_name = File::Spec -> catfile( $self -> {scanned}{ $addr -> domain }{ $addr -> zone }{ $dz_out }{dir},
sprintf( '%04x%04x',
$addr -> net,
$addr -> node,
),
);
}
$busy_name .= '.' . $control_file_extension{busy};
my $busy_name_fs = Encode::encode( locale_fs => $busy_name );
sysopen my $fh, $busy_name_fs, Fcntl::O_WRONLY | Fcntl::O_CREAT | Fcntl::O_EXCL
or $logger -> logdie( 'cannot open %s for writing: %s',
$busy_name,
$!,
);
flock $fh, Fcntl::LOCK_EX
or $logger -> logdie( q[can't flock file %s: %s],
$busy_name,
$!
);
# For information purposes a bsy file may contain one line of PID information (less than 70 characters).
printf $fh '%d %s',
$$,
substr( __FILE__, 0, 70 - 1 - length( $$ ) );
eval {
$sub_ref -> ( $addr,
$self,
);
};
# remove busy first
close $fh;
unlink $busy_name_fs
or $logger -> logwarn( sprintf 'could not unlink %s: %s',
$busy_name,
$!,
);
if ( $@ ) { # something bad happened
$logger -> logdie( 'referenced sub execution failed: %s',
$@,
);
}
$self;
}
=head2 addr_file_to_change
Expects arguments:
address is going to be dealt with as a FTN::Addr object
file type is one of netmail, reference_file, file_request, busy, call, hold, try.
If file type is netmail or reference_file, then next parameter should be its flavour: immediate, crash, direct, normal, hold.
If optional function reference passed, then it will be called with one parameter - name of the file to process. After that information in internal structure about that file will be updated.
Does not deal with busy flag implicitly. Recommended usage is in the function passed to busy_protected_sub.
Returns full name of the file to process (might not exists yet though).
=cut
sub addr_file_to_change { # addr, type ( netmail, file_reference, .. ), [flavour], [ sub_ref( filename ) ].
# figures required filetype name (new or existing) and calls subref with that name.
# does not deal with busy implicitly
# returns full name of the file to be changed/created
my $logger = Log::Log4perl -> get_logger( __PACKAGE__ );
ref( my $self = shift ) or $logger -> logcroak( "I'm only an object method!" );
my $addr = $self -> _validate_addr( shift );
my @flavoured = qw/ netmail
reference_file
/;
( run in 0.274 second using v1.01-cache-2.11-cpan-87723dcf8b7 )