]> dxcluster.org Git - spider.git/commitdiff
add chat_import stuff
authorminima <minima>
Thu, 7 Oct 2004 12:02:18 +0000 (12:02 +0000)
committerminima <minima>
Thu, 7 Oct 2004 12:02:18 +0000 (12:02 +0000)
add importwwv which decodes wwv and solar bulls and sends them to SOLAR

perl/AMsg.pm
perl/DXProt.pm
perl/DXProtout.pm
perl/cluster.pl
perl/importkeps.pl
perl/importwwv.pl [new file with mode: 0755]
perl/process_ursa.pl

index 26ad126971255ec04826f527fa60a8625241073c..06d281d13f95e89292503e37a0c03d22eac5fbab 100644 (file)
@@ -26,7 +26,7 @@ $main::branch += $BRANCH;
 
 use vars qw(@ISA $deftimeout);
 
-@ISA = qw(Msg);
+@ISA = qw(ExtMsg);
 $deftimeout = 60;
 
 sub enqueue
index c96d787e41ba3f27010ef46b385d72765a84e2df..48410eb2ffb50082c87320193086e67b9237dea6 100644 (file)
@@ -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$//; $_ } <MSG>;
+               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__ 
index b31eacdfe111942ded8607bc9759d85e1179a56c..a5498a0c8a45568675d23eb7fc5fea38094dd3e3 100644 (file)
@@ -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^~";
 }
 
index 2449495b70821cfda795152abedb33930dc5a814..83d9bda7174fc1397cf2b11a4a7457752225b406 100755 (executable)
@@ -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);
index aeea441566a58eb537dc517d7f50133931a8af92..fe3cc1142fb940a643c63345b12a2caefbcd3aff 100644 (file)
@@ -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 (executable)
index 0000000..bca6368
--- /dev/null
@@ -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";
+}
+
index 42b5a36054097874e0da0295aa8bfb96ec1173f8..3416d976e58dff57defd92563ca7dd60580e67a8 100644 (file)
@@ -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);