From 45495d980ec748f19509c7668d6b92a06f216ed7 Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 7 Oct 2004 12:02:18 +0000 Subject: [PATCH] add chat_import stuff add importwwv which decodes wwv and solar bulls and sends them to SOLAR --- perl/AMsg.pm | 2 +- perl/DXProt.pm | 71 +++++++++++++++++++++++++++- perl/DXProtout.pm | 8 ++-- perl/cluster.pl | 18 +------- perl/importkeps.pl | 2 +- perl/importwwv.pl | 107 +++++++++++++++++++++++++++++++++++++++++++ perl/process_ursa.pl | 22 +++++++-- 7 files changed, 202 insertions(+), 28 deletions(-) create mode 100755 perl/importwwv.pl diff --git a/perl/AMsg.pm b/perl/AMsg.pm index 26ad1269..06d281d1 100644 --- a/perl/AMsg.pm +++ b/perl/AMsg.pm @@ -26,7 +26,7 @@ $main::branch += $BRANCH; use vars qw(@ISA $deftimeout); -@ISA = qw(Msg); +@ISA = qw(ExtMsg); $deftimeout = 60; sub enqueue diff --git a/perl/DXProt.pm b/perl/DXProt.pm index c96d787e..48410eb2 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -47,8 +47,8 @@ $main::branch += $BRANCH; use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime $last_hour $last10 %eph %pings %rcmds $ann_to_talk - $pingint $obscount %pc19list $chatdupeage - $investigation_int $pc19_version + $pingint $obscount %pc19list $chatdupeage $chatimportfn + $investigation_int $pc19_version %nodehops $baddx $badspotter $badnode $censorpc $rspfcheck $allowzero $decode_dk0wcy $send_opernam @checklist); @@ -75,6 +75,7 @@ $eph_pc34_restime = 30; $pingint = 5*60; $obscount = 2; $chatdupeage = 20 * 60 * 60; +$chatimportfn = "$main::root/chat_import"; $investigation_int = 12*60*60; # time between checks to see if we can see this node $pc19_version = 5466; # the visible version no for outgoing PC19s generated from pc59 @@ -1721,6 +1722,8 @@ sub process # clean out ephemera eph_clean(); + import_chat(); + $last10 = $t; } @@ -2549,5 +2552,69 @@ sub run_cmd { goto &DXCommandmode::run_cmd; } + + +# import any msgs in the chat directory +# the messages are sent to the chat group which forms the +# the first part of the name (eg: solar.1243.txt would be +# sent to chat group SOLAR) +# +# Each message found is sent: one non-blank line to one chat +# message. So 4 lines = 4 chat messages. +# +# The special name LOCAL is for local users ANN +# The special name ALL is for ANN/FULL +# The special name SYSOP is for ANN/SYSOP +# +sub import_chat +{ + # are there any to do in this directory? + return unless -d $chatimportfn; + unless (opendir(DIR, $chatimportfn)) { + dbg("can\'t open $chatimportfn $!") if isdbg('msg'); + Log('msg', "can\'t open $chatimportfn $!"); + return; + } + + my @names = readdir(DIR); + closedir(DIR); + my $name; + foreach $name (@names) { + next if $name =~ /^\./; + my $splitit = $name =~ /^split/; + my $fn = "$chatimportfn/$name"; + next unless -f $fn; + unless (open(MSG, $fn)) { + dbg("can\'t open import file $fn $!") if isdbg('msg'); + Log('msg', "can\'t open import file $fn $!"); + unlink($fn); + next; + } + my @msg = map { s/\r?\n$//; $_ } ; + close(MSG); + unlink($fn); + + my @cat = split /\./, $name; + my $target = uc $cat[0]; + + foreach my $text (@msg) { + next unless $text && $text !~ /^\s*#/; + if ($target eq 'ALL' || $target eq 'LOCAL' || $target eq 'SYSOP') { + my $sysopflag = $target eq 'SYSOP' ? '*' : ' '; + if ($target ne 'LOCAL') { + send_announce($main::me, pc12($main::mycall, $text, '*', $sysopflag), $main::mycall, '*', $text, $sysopflag, $main::mycall, '0'); + } else { + Log('ann', 'LOCAL', $main::mycall, $text); + DXChannel::broadcast_list("To LOCAL de ${main::mycall}: $text\a", 'ann', undef, DXCommandmode->get_all()); + } + } else { + my $msgid = nextchatmsgid(); + $text = "#$msgid $text"; + send_chat($main::me, pc12($main::mycall, $text, '*', $target), $main::mycall, '*', $text, $target, $main::mycall, '0'); + } + } + } +} + 1; __END__ diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index b31eacdf..a5498a0c 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -68,12 +68,12 @@ sub pc12 { my ($call, $text, $tonode, $sysop, $wx, $origin) = @_; my $hops = get_hops(12); - $origin ||= $main::mycall; - $sysop ||= ' '; $text ||= ' '; - $wx ||= '0'; - $tonode ||= '*'; $text =~ s/\^/%5E/g; + $tonode ||= '*'; + $sysop ||= ' '; + $wx ||= '0'; + $origin ||= $main::mycall; return "PC12^$call^$tonode^$text^$sysop^$origin^$wx^$hops^~"; } diff --git a/perl/cluster.pl b/perl/cluster.pl index 2449495b..83d9bda7 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -195,24 +195,8 @@ sub new_channel $user = DXUser->new($call); } - # create the channel - if ($user->wantnp) { - if ($user->passphrase && $main::me->user->passphrase) { - $dxchan = QXProt->new($call, $conn, $user); - } else { - unless ($user->passphrase) { - Log('DXCommand', "$call using NP but has no passphrase"); - dbg("$call using NP but has no passphrase"); - } - unless ($main::me->user->passphrase) { - Log('DXCommand', "$main::mycall using NP but has no passphrase"); - dbg("$main::mycall using NP but has no passphrase"); - } - already_conn($conn, $call, "Need to exchange passphrases"); - return; - } - } elsif ($user->is_node) { + if ($user->is_node) { $dxchan = DXProt->new($call, $conn, $user); } elsif ($user->is_user) { $dxchan = DXCommandmode->new($call, $conn, $user); diff --git a/perl/importkeps.pl b/perl/importkeps.pl index aeea4415..fe3cc114 100644 --- a/perl/importkeps.pl +++ b/perl/importkeps.pl @@ -3,7 +3,7 @@ # Take a 2 line keps email file on STDIN, prepare it for import into standard import directory # and then shove it there, marked for SB ALL. # -# Copyright (c) Dirk Koopman G1TLH +# Copyright (c) 2004 Dirk Koopman G1TLH # # $Id$ # diff --git a/perl/importwwv.pl b/perl/importwwv.pl new file mode 100755 index 00000000..bca63688 --- /dev/null +++ b/perl/importwwv.pl @@ -0,0 +1,107 @@ +#!/usr/bin/perl +# +# Process and import for mail WWV and Solar Data +# +# This program takes a mail message on its standard input +# and, if it is WWV or Solar info, imports it into the local +# spider chat_import queue. +# +# Both the "tmp" and the "chat_import" directories should be +# chmod 1777 +# +# Copyright (c) 2004 Dirk Koopman G1TLH +# +# $Id$ +# + +use strict; +use Mail::Internet; +use Mail::Header; + +our $root; + +# search local then perl directories +BEGIN { + # root of directory tree for this system + $root = "/spider"; + $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + + unshift @INC, "$root/perl"; # this IS the right way round! + unshift @INC, "$root/local"; +} + +my $import = "$root/chat_import"; +my $tmp = "$root/tmp"; + +my $msg = Mail::Internet->new(\*STDIN) or die "Mail::Internet $!"; +my $head = $msg->head->header_hashref; + +if ($head) { + if ($head->{From}->[0] =~ /wwv/i || $head->{'From '}->[0] =~ /wwv/i) { + process_wwv($msg); + } elsif ($head->{From}->[0] =~ /rwc\.boulder/i || $head->{'From '}->[0] =~ /rwc\.boulder/i) { + process_solar($msg); + } +} + +exit(0); + +sub process_wwv +{ + my $msg = shift; + my @out; + my $state; + + foreach (@{$msg->body}) { + next if /^\s*:/; + next if /^\s#/; + next if /^\s*\r?\n$/s; + if (/follow/) { + $state = 1; + next; + } + if ($state) { + my $l = $_; + $l =~ s/\s*\.?\r?\n$//; + push @out, $l; + } + } + out(@out) if @out; +} + +sub process_solar +{ + my $msg = shift; + my @out; + my $state; + + foreach (@{$msg->body}) { + if (!$state && /Space\s+Weather\s+Message\s+Code:/i) { + $state = 1; + } + if ($state == 1 && /^[A-Z]+:/) { + $state = 2; + } + if ($state == 2 && /^\s*\r?\n$/s) { + last; + } + if ($state > 1) { + my $l = $_; + $l =~ s/\r?\n$//; + push @out, $l; + } + } + out(@out) if @out; +} + +sub out +{ + my $fn = "solar.txt.$$"; + + open OUT, ">$tmp/$fn" or die "import $tmp/$fn $!"; + print OUT map { "$_\n" } @_; + close OUT; + link "$tmp/$fn", "$import/$fn"; + unlink "$tmp/$fn"; +} + diff --git a/perl/process_ursa.pl b/perl/process_ursa.pl index 42b5a360..3416d976 100644 --- a/perl/process_ursa.pl +++ b/perl/process_ursa.pl @@ -6,7 +6,7 @@ # and, if it is an URSIGRAM, imports it into the local # spider msg queue. # -# Copyright (c) Dirk Koopman G1TLH +# Copyright (c) 2004 Dirk Koopman G1TLH # # $Id$ # @@ -15,7 +15,20 @@ use strict; use Mail::Internet; use Mail::Header; -my $import = '/spider/msg/import'; +our $root; + +# search local then perl directories +BEGIN { + # root of directory tree for this system + $root = "/spider"; + $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + + unshift @INC, "$root/perl"; # this IS the right way round! + unshift @INC, "$root/local"; +} + +my $import = "$root/msg/import"; +my $tmp = "$root/tmp"; my $msg = Mail::Internet->new(\*STDIN) or die "Mail::Internet $!"; my $head = $msg->head->header_hashref; @@ -31,11 +44,14 @@ if ($head && $head->{From}->[0] =~ /sidc/i && $head->{Subject}->[0] =~ /Ursigram last; } } - open OUT, ">$import/ursigram$date.txt" or die "import $!"; + my $fn = "ursigram$date.txt.$$"; + open OUT, ">$tmp/$fn" or die "import $tmp/$fn $!"; print OUT "SB ALL\n$title\n"; print OUT map {s/\r\n$/\n/; $_} @$body; print OUT "/ex\n"; close OUT; + link "$tmp/$fn", "$import/$fn"; + unlink "$tmp/$fn"; } exit(0); -- 2.34.1