[pskmail] Beacon

  • From: "Per Crusefalk" <per@xxxxxxxxxxxx>
  • To: pskmail@xxxxxxxxxxxxx
  • Date: Thu, 1 Mar 2007 10:06:51 +0100 (CET)

Here is rflinkserver.pl from my server, it works.
Does your version look the same ?

Rein:
Could we have failed to sync properly when checking in or something ?
I include a somewhat cleaned version of serverbeacons as well, comments
are cleaned and old commented code removed.

73 de Per
#! /usr/bin/perl -w



# ARQ module rflinkserver.pl by PA0R. This module is part of the PSK_ARQ suite 
of

# programs. Rflinkserver contains the server protocol engine which adds an arq 
layer 

# to keyboard oriented protocols like PSK31, PSK63, MFSK, MT63 etc.



# Rflinkserver.pl includes the arq primitives for the server.



# This program is published under the GPL license.

#   Copyright (C) 2005, 2006, 2007

#       Rein Couperus PA0R (rein@xxxxxxxxxxxx)

# 

# *    rflinkserver.pl is free software; you can redistribute it and/or modify

# *    it under the terms of the GNU General Public License as published by

# *    the Free Software Foundation; either version 2 of the License, or

# *    (at your option) any later version.

# *

# *    rflinkserver.pl is distributed in the hope that it will be useful,

# *    but WITHOUT ANY WARRANTY; without even the implied warranty of

# *    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

# *    GNU General Public License for more details.3

# *

# *    You should have received a copy of the GNU General Public License

# *    along with this program; if not, write to the Free Software

# *    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA



#Last change: 210207



use arq;

#use Net::POP3;

use Mail::POP3Client;

use Net::SMTP;

use DB_File;

use IO::Handle;

use MIME::Base64;

use Time::Local;

use Email::LocalDelivery;
use Email::Folder;


my $debug_mail = 1;

my $monitor = 1;

my $opensystem = 1;

my $Use_ssl = 0;



my ($ServerCall, $Inputfile, $output, $dbfile, $dbpass, $dbaddress, $relay, 
$Max_retries, $Maxidle,$Maxwebpage, $nosession, $commandcall, $Beaconminute, 
$Aprs_connect, $Aprs_beacon, $Aprs_port, $Aprs_address, @prefixes, $posit_time, 
$scheduler, @schedule, $rigtype, $rigrate, $rigdevice, $scanner, $qrgfile, 
$freq_offset, @freq_corrections, @Beaconarray);



if (-e "pskmailrc.pl") {

        eval `cat pskmailrc.pl`

        or die "No config file: $@\n";

}



if (-e "$ENV{HOME}/scheduler.pl") {

        eval `cat $ENV{HOME}/scheduler.pl` or die "Could not interpret 
scheduler file\n";

                # get the schedule if there is one...

        $scheduler = 1;

}



my $modem = "PSK125";



setmode ($modem);



my ($reader, $writer);

pipe($reader, $writer);

$writer->autoflush(1);



my $ConnectStatus = "Listening";

my $TextFromFile = "";

my $Status = "Listen";

my $RxStatus = "";

my $Systemstatus = "";

my $Retries = 0;

my $RxReady = 0;

my $outputstring = "";



my $Version = "0.2.9";

my $Pop_host =  "";     # pop3 provider

my $Pop_user =  "";     # pop user

my $Pop_pass =  "";     # pop password

my $address =   "";     # set return address for SMTP....

my $mailuser =  ".mailuser";    # data store where the mail is received with 
fetchmail...

my $findupasswd = "";   # password for APRS



my $Usercalls = "";

my $usrmessage = "";

my $call = "";
my $dummy = 0;          # dummy variable

my $mymailnumber = 0;

my @msgarray = ();

#scheduler

my $systime = 0;

my $lasthour = 0;

#scanner

my $oldhour = 0;

my $oldmins = 0;

my @freqs = ();

my @modes = (); 

my @freqhrs = ();

# beacon

my $Beacon_sent = 0;

my @Beacons_sent = qw (0 0 0 0 0);      # Keeps track of beacons, have they 
been sent this time around ?





                if ($scanner && -e "./qrg/freqs.txt") {

                        open ($fh, $qrgfile) or die "Cannot open the scanner 
file!";

                        @freqhrs = <$fh>;

                        close ($fh);

                        

                        $hour = (time / 3600) % 24;             

                        $cat = $freqhrs[0];

                        print "Scanning: $cat";

                        print "Offset = $freq_offset minute(s)\n";

                        chomp $cat;

                        @freqs = split (",", $cat);

                        

                        my $pskmodes = $freqhrs[1];

                        @modes = split (",", $pskmodes);                        

                }





$ConnectStatus = "Listening";



print "$Aprs_connect\n";



# open aprs write port



#my ($udp_ipaddr,$udp_portaddr);



$error = `echo "none" > PSKmailsession`;

$error = `touch zb`;



initialize();



        open SESSIONDATA, ">PSKmailsession";

        print SESSIONDATA $nosession;

        close SESSIONDATA;





#get users from data base

        getusercalls();



{

        my @shortcallusers = split (" ", ($ServerCall . " " . $Usercalls));

        open (CALLS, ">calls.txt");

        foreach my $call (@shortcallusers) {

                print CALLS $call, "\n";

        }

        close CALLS;

}



if ($pid = fork) {

        close $writer;

        

        

        while (1) {

                my $readline= "";       

                select undef, undef, undef, 0.1;

                eval {

                        local $SIG{ALRM} = sub { die "timeout" };

                        alarm 10;

                        eval {

                                $readline = <$reader>;

                        };

                };

                alarm 0;

                die if $@ && $@ !~ /timeout/;

                

                if ($readline) {

                        chomp($readline);

                        if ($monitor) {

                                print $readline, "\n";

                        }

                        $_ = $readline;



                        if (m/~TEST/) {

                                `cat testfile >> TxInputfile`;

                        } elsif (m/~QUIET!/) {

####### switch beacon off #################################

                                if (get_session() eq $commandcall) {

                                        $nosession = "none";

                                        print "Beacon off...\n";

                                        `echo "Beacon off" > TxInputfile`;

                                }

                        } elsif (m/~BEACON!/) {

####### switch beacon on #################################

                                if (get_session() eq $commandcall) {

                                        $nosession = "beacon";

                                        `echo "Beacon on" > TxInputfile`;       
                                

                                }

                        } elsif (m/~SPEEDUP!/) {

####### switch modem #################################

                                        sleep 10;

                                        open (CMD, $output);

#                                       print CMD 
'<cmd><mode>PSK125></mode></cmd>';

                                        close (CMD);

                                        open (CMD, ">.modem");

                                        print CMD 'PSK125';

                                        close (CMD);

                        } elsif (m/~SPEEDDOWN!/) {

####### switch modem #################################

                                        sleep 10;

                                        open (CMD, $output);

#                                       print CMD 
'<cmd><mode>PSK63></mode></cmd>';

                                        close (CMD);

                                        open (CMD, ">.modem");

                                        print CMD 'PSK63';

                                        close (CMD);

                        } elsif (m/~STATUS?/) {

####### switch beacon on #################################

                                if (get_session() eq $commandcall) {

                                        my $uptime = `uptime`;

                                        my $mem = `df | grep hda`;

                                        if ($mem =~ /(\d*%)/) { $mem = "MM = " 
. $1 . "\n";}

                                        my $pingout = "No internet connection";

                                        my @ping = ();

                                        eval {

                                                @ping = `ping -c 1 pskmail.org 
2>/dev/null`;

                                        };

                                        if($ping[1] && $ping[1] =~ 
/(time=\d*\.*\d* ms)/) {

                                                $pingout = "Ping " . $1;

                                        }

                                        `echo "\nServer 
status:\n$uptime$mem$pingout\n" > TxInputfile`;                                 

                                }

                        } elsif (m/~GETBEACONS/) {

####### switch beacon on #################################

                                my $call = get_session();

                                        my $beacons = getbeacons($call);

                                        `echo "$beacons" > TxInputfile`;        
                                

                                

                        }elsif (m/~QTC\?/) {

####### get list of headers #################################

                                

                                getuserdata(get_session());



                                if ($Pop_host) {

                                        eval {

                                                list_mail() ; # get mail from 
pop server

                                        };

                                        if ($@) {

                                                `echo "Cannot get the mail 
headers...$@" > TxInputfile`;

                                        } else {

                                                logprint ("QTC received...\n");

                                                if ($monitor && $debug_mail) {

                                                        print `cat 
mailheaders`;                        

                                                }

                                                if (-s "mailheaders" < 10) {

                                                        `echo "No mail" > 
TxInputfile`;

                                                }elsif (-e "mailheaders") {

                                                        my $hdrlength = length 
(`cat mailheaders`);

                                                        `echo "Your mail:" >> 
TxInputfile`;

                                                        my $headers = `cat 
mailheaders >> TxInputfile`;

                                                        `echo "-end-" >> 
TxInputfile`;

                                                        unlink "mailheaders";

                                                }

                                        }

                                } else {

                                                `echo "Cannot get your mail!" 
>> TxInputfile`;                          

                                }

                        }elsif (m/~QTC (\d*)\+/) {

####### get list of headers from nr. #########################

                                

                                my $starthdr = $1;

                                getuserdata(get_session());

                                

                                print "Req. QTC from $starthdr\n";



                                if ($Pop_host) {

                                        eval {

                                                list_mail() ; # get mail from 
pop server

                                        };

                                        if ($@) {

                                                `echo "Cannot get the mail 
headers...$@" > TxInputfile`;

                                        } else {

                                                logprint ("QTC received...\n");

                                                if ($monitor && $debug_mail) {

                                                        print `cat 
mailheaders`;                        

                                                }

                                                if (-s "mailheaders" < 10) {

                                                        `echo "No mail" > 
TxInputfile`;

                                                }elsif (-e "mailheaders") {

                                                        my $hdrlines = `wc -l 
"mailheaders"`;

                                                        if ($hdrlines =~ 
m/(\d*)/) {

                                                                $hdrlines = $1;

                                                        }



                                                        my $newhdrs = $hdrlines 
- $starthdr;                                                    



                                                        if ($newhdrs > 1) {

                                                                `echo "Your 
mail:" >> TxInputfile`;

                                                                my $headers = 
`tail -n $newhdrs mailheaders >> TxInputfile`;

                                                                `echo "-end-" 
>> TxInputfile`;

                                                                unlink 
"mailheaders";

                                                        } else {

                                                                my $hdrs = 
$hdrlines - 2;

                                                                `echo "Sorry, 
only $hdrs mails" >> TxInputfile`;

                                                        }

                                                }

                                        }

                                } else {

                                                `echo "Cannot get your mail!" 
>> TxInputfile`;                          

                                }

                        } elsif (m/~MAIL/) {

####### get ALL mail #################################

                                getuserdata(get_session());

                                if ($Pop_host) {

                                        eval {

                                                read_mail(1 ... $Count) ; # get 
mail from pop server

                                        };

                                        if ($@) {

                                                `echo "Cannot get your mail: $@ 
> TxInputfile`;

                                        } else {

                                                filter($mailuser, 0);

                                                if ($debug_mail) {`cat 
mailfile`;}

                                                `mv mailfile TxInputfile`;

                                                `echo "-end-" >> TxInputfile`;

                                        }

                                } else {

                                                `echo "Cannot get your mail!" 
>> TxInputfile`;

                                }

                        } elsif (m/~LISTLOCAL(.*)/) {

####### list local mails #################################

                                my $call = get_session();

                                
                                if (-e "localmail/$call") {
                                        my $folder = 
Email::Folder->new("localmail/$call");
                                        my $mails = "";
                                        my $count = 0;

                                        for my $msg ($folder->messages) {
                                                $count++;
                                                print $count, " ", 
$msg->header("From"), " ", $msg->header("Subject"), "\n";
                                                $mails .= $count . " ". 
$msg->header("From") . " " . $msg->header("Subject") . "\n";
                                        }
                                        `echo "Local mail for $call:\n" >> 
TxInputfile`;
                                        `echo "$mails" >> TxInputfile`;         
                
                                        `echo "-end-" >> TxInputfile`;
                                } else {
                                        `echo "No local mail for $call:\n" >> 
TxInputfile`;                                     
                                }
                                
                        } elsif (m/~DELETELOCAL (.*)/) {

####### delete local mails #################################

                                my $call = get_session();
                                my $msgnr = 1 unless $1;
                                my @numbers = split / /, $1;                    
        
                                
                                if (-e "localmail/$call") {
                                        my $folder = 
Email::Folder->new("localmail/$call");
                                        my $mails = "";
                                        my $count = 0;
                                        for my $msg ($folder->messages) {
                                                $count++;
                                                my $del = 1;
                                                for $msgnr (@numbers) {
                                                        if ($count == $msgnr) { 
                                                                $del = 0;
                                                        }
                                                } 
                                                if ($del) {                     
                        
                                                        $mails .= "From $call " 
.
                                                        $msg->header("Date") . 
"\n" .
                                                        $msg->as_string . 
"\n\n";
                                                }
                                        }
                                        open (MAILS, ">", "localmail/$call");
                                        print MAILS $mails;
                                        close (MAILS);
                                        `echo "Mails $1 deleted..." >> 
TxInputfile`;                            
                                } else {
                                        `echo "No local mail for $call:\n" >> 
TxInputfile`;                                     
                                }
                        } elsif (m/~READLOCAL (.*)/) {

####### read local mails #################################

                                my $call = get_session();
                                my $msgnr = 1 unless $1;
                                my @numbers = split / /, $1;                    
        
                                                                

                                
                                if (-e "localmail/$call") {
                                        my $folder = 
Email::Folder->new("localmail/$call");
                                        my $mails = "";
                                        my $count = 0;

                                        for my $msg ($folder->messages) {
                                                $count++;
                                                for $msgnr (@numbers) {
                                                        if ($count == $msgnr) {
                                                                $mails .= 
"Message $count for $call:\n" . 
                                                                "From: ". 
$msg->header("From") . 
                                                                "\nSubject: " . 
                                                                
$msg->header("Subject") . "\n" .
                                                                "Date: " .
                                                                
$msg->header("Date") . "\n\n" .
                                                                $msg->body . 
"\n" ;
                                                        }
                                                }
                                        }
                                        `echo "$mails" >> TxInputfile`;         
                
                                        `echo "\n-end-\n" >> TxInputfile`;
                                } else {
                                        `echo "No local mail for $call:\n" >> 
TxInputfile`;                                     
                                }
                                
                        } elsif (m/~READBIN(.*)/) {

####### get single mails #################################

                                getuserdata(get_session());

                                my @numbers = split / /, $1;

                                eval {

                                        read_mail(@numbers);

                                };

                                if ($@) {

                                        `echo "Cannot get your mail: $@" > 
TxInputfile`;

                                } else {

                                        filter($mailuser, 0);

                                        `./.cbh/cbh_code.pl -f mailfile -o 
TxInputfile`;

                                        if ($debug_mail) {`cat mailfile`;}

                                        unlink "mailfile";

                                }

                        } elsif (m/~READ(.*)/) {

####### get single mails #################################

                                getuserdata(get_session());

                                my @numbers = split / /, $1;

                                eval {

                                        read_mail(@numbers);

                                };

                                if ($@) {

                                        `echo "Cannot get your mail: $@" > 
TxInputfile`;

                                } else {

                                        filter($mailuser, 0);

                                        my $msglen = -s "mailfile";

                                        `echo "Your msg: $msglen" >> 
TxInputfile`;

                                        `cat mailfile >> TxInputfile`;

                                        `echo "-end-" >> TxInputfile`;

                                        if ($debug_mail) {`cat mailfile`;}

                                        unlink "mailfile";

                                }

                        } elsif (m/~KEEP(.*)/) {

####### send mail to archive #################################

####### changer subject to [Mailarchive]date #################



                                getuserdata(get_session());

                                my @numbers = split / /, $1;

                                eval {

                                        read_mail(@numbers);

                                };

                                if ($@) {

                                        `echo "Cannot get your mail: $@" > 
TxInputfile`;

                                } else {

                                        filter($mailuser, 1);

                                        

                                        @message = ();

                                        

                                        my $call = get_session();

                                        getuserdata($call);

                                        

                                        my $subject = "[Mailarchive] " . `date`;

                                        my $to = $address;

                                        

                                        push @message, $to;

                                        push @message, $address;

                                        push @message, $subject;

                                        

                                        open ($MA, "mailfile");

                                        my @body = <$MA>;

                                        close ($MA);

                                        foreach my $messageline (@body) {

                                                chomp $messageline;

                                        }

                                        push @message, @body;



                                        eval {

                                                send_mail(@message);    # send 
the mail via smtp

                                        };

                                        if ($@) {

                                                `echo "Error sending mail : $@" 
>> TxInputfile`;

                                        } else {

                                                `echo "\nArchive $1 sent...\n" 
>> TxInputfile`;

                                        }

                                        @message = ();

                                        unlink "mailfile";

                                }

                        } elsif (m/~GETFILE (.*)/) {

####### get file from ./pskdownload dir #################################

                                my $grb = `cat ./pskdownload/$1`;

                                $grb =~ s/\r\n/\n/g;

                                `echo "$grb" > TxInputfile`;                    
        

                                `echo "-end-" >> TxInputfile`;

                        } elsif (m/~GETBIN (.*)/) {

####### get file from ./pskdownload dir #################################

                                my $filenm = $1;

print "$filenm\n";

                                my $grb = "";

                                if (-e "./pskdownload/$1") {

                                        if (substr ($filenm, -2) ne "gz" && 
substr ($filenm, -3) ne "bz2") {

                                                `gzip -f -9 
./pskdownload/$filenm`;

                                                $filenm .= ".gz";

                                                $grb = `cat 
./pskdownload/$filenm`;

                                                `gunzip ./pskdownload/$filenm`;

                                        } else {

                                                $grb = `cat 
./pskdownload/$filenm`;

                                        }

                                        $grb = encode_base64 ($grb);

                                        $lqrb = length ($grb);

                                        `echo "Your file:$filenm $lqrb" >> 
TxInputfile`;

                                        `echo "$grb" >> TxInputfile`;           
                

                                        `echo "-end-" >> TxInputfile`;

                                } else {

                                        `echo "File not found!" >> TxInputfile`;

                                }

                        } elsif (m/~LISTFILES/) {

####### list files from ./pskdownload dir #################################

                                my $filelist = `ls -l ./pskdownload`;

                                @filelines = split ("\n", $filelist);

                                $filelist = "";

                                foreach $fileline (@filelines) {

                                        if ($fileline =~ /.*1(.*) (.*) (.*) 
(.*) (.*)/) {

                                                $filelist = $filelist . $5 . " 
" . $3 . " " .  $4 . " " . $2 . "\n";    

                                        }

                                }

                                my $grb = `echo "$filelist" >> TxInputfile`;

                                $grb = `echo "-end-" >> TxInputfile`;

                                $filelist = "";

                        } elsif (m/~TGET (.*)/) {

####### dump web page with elinks #################################

                                my $URL = $1;

                                my $webpage = "";

 

                                if ($monitor) {

                                        print "Trying $URL\n";

                                }

                                `echo "Trying $URL\n" >> TxInputfile`;

                                

                                eval {

                                        $webpage =  `elinks -dump $URL 2>&1` or 
die "No page";

                                };



                                if ($webpage =~ /^Alert!/m) { $webpage = 
"Timeout!\n"; }

                                

                                if ($@ && $@ =~ /No page/) {

                                        if ($monitor) {

                                                print "404\n";

                                        }

                                        `echo "404\n" > TxInputfile`;

                                } else {

                                

                                        if (length $webpage > $Maxwebpage) {

                                                $webpage = substr ($webpage, 0, 
$Maxwebpage);

                                                $webpage .= "\n-truncated 
-\n\n";

                                        } 

                                        my $weblength = length ($webpage);

                                        `echo "Your wwwpage: $weblength" >> 
TxInputfile`;

                                        `echo "$webpage \n\n" >> TxInputfile`;

                                        `echo "-end-\n" >> TxInputfile`;

                                        if ($monitor) {

                                                print $webpage;

                                        }

                                

                                }

                        } elsif (m/~GETPOS\s*(.*)/) {

####### get position from findu.com  #################################

                                my $poscall = "";

                                my $webpage = "";

                                

                                if (-e ".internet") {
                                        if (defined $1 && $1) {

                                                $poscall = $1;

                                        } else {

                                                $poscall = get_session();

                                        }

                                        my $URL = 
"http://loudmouth.findu.com/cgi-bin/find.cgi?call="; . $poscall;

         

                                                eval {

        #                                               $webpage =  `lynx -dump 
-connect_timeout=10 $URL 2>&1` or die "No page";

                                                        $webpage =  `elinks 
-dump $URL 2>&1` or die "No page";

                                                        print $webpage;

                                                };

                                        if ($webpage =~ /^Alert!/m) { $webpage 
= ""; }

                                }

                                if ($webpage) {

                                        

                                        if ($@ && $@ =~ /No page/) {

                                                if ($monitor) {

                                                        print "404\n";

                                                }

                                                `echo "Sorry, page not 
available\n" > TxInputfile`;

                                        } else {

                                                my @positpage = split /\n/, 
$webpage;

                                                my $positline = "";

                                                my @outarray = ();

                                                foreach $positline (@positpage) 
{

                                                        if ($positline =~ 
/Position of/) {push @outarray, $positline; }

                                                        if ($positline =~ 
/received/) {push @outarray, $positline; }

                                                        if ($positline =~ /Raw 
packet/) {push @outarray, $positline; }

                                                }

                                                $webpage = join "\n", @outarray;

                                                `echo "$webpage \n\n" >> 
TxInputfile`;

                                                `echo "-end-\n" >> TxInputfile`;

                                                if ($monitor) {

                                                        print $webpage;

                                                }

                                        }

                                } else {

                                        `echo "Cannot get position\n" >> 
TxInputfile`;

                                }

                        } elsif (m/~GETMSG\s*(\d*)/) {

####### get messages from findu.com  #################################

                                my $msgnr = "";

                                

                                if (-e ".internet"){
                                        if ( $1 && $1 > 0) {

                                                $msgnr = $1;

                                        } else {

                                                $msgnr = 10;

                                        }

                                        my $URL = 
"http://www.findu.com/cgi-bin/msg.cgi?call="; . get_session();

                                        my $webpage = "";

         

                                        eval {

                                                $webpage =  `lynx 
-connect_timeout=10 -dump $URL 2>&1` or die "No page";

                                        };



                                        if ($webpage =~ /^Alert!/m) { $webpage 
= "Cannot connect\n";}

                                        

                                        if ($@ && $@ =~ /No page/) {

                                                if ($monitor) {

                                                        print "404\n";

                                                }

                                                `echo "Sorry, page not 
available\n" > TxInputfile`;

                                        } else {

                                                my @positpage = split /\n/, 
$webpage;

                                                my $positline = "";

                                                my @outarray = ();

                                                my $counter = 0;

                                                foreach $positline (@positpage) 
{

                                                        if ($positline !~ 
/\+---/) {

                                                                push @outarray, 
$positline; 

                                                                $counter++;

                                                                if ($counter > 
$msgnr) {

                                                                        last;   
                                        

                                                                }

                                                        }

                                                }

                                        

                                                $webpage = join "\n", @outarray;

                                                `echo "$webpage \n\n" >> 
TxInputfile`;

                                                `echo "-end-\n" >> TxInputfile`;

                                                if ($monitor) {

                                                        print $webpage;

                                                }

                                        }
                                } else {
                                        `echo "Sorry, internet not available\n" 
> TxInputfile`;
                                
                                }

                        } elsif (m/~MSG (\w*)\s*(\S*\@\S*)\s*(.*)/) {

####### send aprs mail #################################

                                my $call = $1;

                                getuserdata($call);

                                        $to = $2;

                                        $subject = "PSKaprs message from $1";

                                        @message = ();

                                        push @message, $to;

                                        push @message, $address;

                                        push @message, $subject;

                                        push @message, $3;

                                        logprint ("sending mail message to 
$2\n");

                                        eval {

                                                send_mail(@message);    # send 
the mail via smtp

                                        };

                                        if ($@) {

                                                logprint ("Could not send aprs 
email message\n");

                                         }

                                

                        } elsif (m/~POSITION (\d+\.\d+) (\d+\.\d+)/) {

####### send position to findu.com #################################

                                

                                if (-e ".internet") {
                                        
                                        my $call = get_session();

                                        getuserdata($call);

                                        if ($findupasswd) {

                                        

                                                my $pos_string = 
"call=$call&passwd=$findupasswd&lat=$1&lon=$2\n";



                                                $to = "posit\@findu.com";

                                                $subject = "none";

                                                @message = ();

                                                push @message, $to;

                                                push @message, $address;

                                                push @message, $subject;

                                                push @message, $pos_string;



                                                eval {

                                                        send_mail(@message);    
# send the mail via smtp

                                                };

                                                if ($@) {

                                                        `echo "Cannot send 
position: $@" >> TxInputfile`;

                                                 } else {

                                                        `echo "\nPosition 
sent...\n" >> TxInputfile`;

                                                        @message = ();

                                                }

                                        } else {

                                                `echo "Sorry, no password on 
file!\n" >> TxInputfile`;

                                        }
                                } else {
                                                `echo "Sorry, internet not 
available\n" > TxInputfile`;                         
                                }

                                

                        } elsif (m/~QUIT/) {

####### Quit connect  #################################

                                logprint ("Disconnect received\n");

#                               disconnect();

                                $ConnectStatus = "Disconnected";



                                open SESSIONDATA, ">PSKmailsession";

                                print SESSIONDATA $nosession;

                                close SESSIONDATA;





                        } elsif (m/~DELETE(.*)/) {

####### delete message(s) from POP #################################

                                my @numbers = split / /, $1;

                                eval {

                                        delete_mail(@numbers);

                                };

                                if ($@) {

                                        `echo "Cannot delete mail: $@" > 
TxInputfile`;

                                } else {

                                        filter($mailuser, 0);

                                        `echo "Mail $1 deleted...\n" >> 
TxInputfile`;

                                }

                        } elsif (m/~RECx(.*)$/) {

####### Update user database for CALL #################################

                                

                                my $call = get_session();               



                                eval {  

                                        my $rec = decode_base64($1);

                                        my @values = split (/,/ , $rec);

                                        

                                        $Pop_host = shift @values;

                                        my $record = $Pop_host . ",";

                                        $Pop_user = shift @values;

                                        $record .= ($Pop_user . ",");

                                        $Pop_pass = shift @values;

                                        $record .= ($Pop_pass . ",");

                                        $record .= ("smtp_host,");

                                        $address = shift @values;

                                        $record .= ($address . ",");

                                        $mailuser = ".mailuser";

                                        $record .= ($mailuser . ",");

                                        $findupasswd = shift @values;

                                        chomp $findupasswd;

                                        $record .= ($findupasswd . ",");

                                        

                                        tie (%db, "DB_File", $dbfile) 

                                                or die "Cannot open user 
database\n";

                                                

                                        $db{$call} = $record;

                                        

                                        untie %db;

                                };

                                if ($@) {

                                        print "Error in database: $@\n";

                                } else {

                                        print "Updating database for $call\n";

                                        `echo "Updated database for $call" >> 
TxInputfile`;

                                }

                                        

                        } elsif (m/~SEND/) {

####### send message file #################################

                                my @message = ();       # $to, $from, $subject, 
@body

                        

                                my $mailstatus = "receive";

                                

                                logprint ("Receiving mail \n");

                                

                                @body = ();

                                

                                while ($mailstatus eq "receive") {

                                        

                                        

                                        my $readline = <$reader>;

                                        

                                        

                                        if ($readline) {

                                        

                                                reset_idle();

                                                chomp($readline);

                                                if ($monitor) {

                                                        print $readline, "\n";

                                                }

                                                $_ = $readline;

                                                if (m/^\.$/) {

                                                        $mailstatus = 
"end_of_mail";

                                                        @message = ();

                                                        

                                                        my $call = 
get_session();

                                                        getuserdata($call);

                                                        

                                                        push @message, $to;

                                                        push @message, $address;

                                                        push @message, $subject;

                                                        push @message, @body;
#                                                       $dummy = pop @body;
                                                        
                                                        if ($to =~ 
/(.*)\@$ServerCall/) { # local mbox
                                                                print "Local 
mbox $1\n";
                                                                if (-e 
"localmail/$1") {
                                                                        print 
"Local mbox $1 exists\n";
                                                                } else {
                                                                        `touch 
"localmail/$1"`;
                                                                        print 
"Local mbox $1 made\n";
                                                                }
                                                                my $mydate = 
`date`;                                            
                                                                my $msg =
                                                                        "From 
$call $mydate" .
                                                                        "To: 
$to" . "\n" .
                                                                        "From: 
$address" . "\n" . 
                                                                        
"Subject: " . $subject . "\n" . 
                                                                        "Date: 
$mydate" . "\n" .
                                                                        join 
("\n", @body) . "\n\n";
                                                                        
                                                                my @boxes = 
("localmail/$1");   
                                                                my 
@delivered_to = Email::LocalDelivery->deliver($msg, @boxes);
                                                                
                                                                @message = ();  
                                                                `echo 
"\nMessage sent...\n" >> TxInputfile`;


                                                        } else {                
                                # internet mbox



                                                                eval {

                                                                        
send_mail(@message);    # send the mail via smtp

                                                                };

                                                                if ($@) {

                                                                        `echo 
"Error sending mail : $@" >> TxInputfile`;

                                                                } else {

                                                                        `echo 
"\nMessage sent...\n" >> TxInputfile`;

                                                                }

                                                                @message = ();
                                                        }

                                                }

                                                elsif (m/~ABORTSEND/) { # in 
case we are stuck in a loop

                                                        # stop.....  

                                                        $to = "";

                                                        $subject  = "";

                                                        @body = ();

                                                        last;

                                                }

                                                elsif (m/Subject: /) {

                                                        # add subject 

                                                        my $subjectline = 
substr($readline, 9);

                                                        $subject = $subjectline 
;

                                                }

                                                elsif (m/To: /) {



                                                        # write  To: 

                                                        

                                                        $to = substr($readline, 
4);

                                                } else {

                                                        push @body, $readline;

                                                }

                                        } 

                                }       # end mail receive

                                

                        }

                        $readline = "";

                } else {   

####### scheduler #################################

                

                        if ($scheduler) {               # try the scheduler...

                                $thishour = (gmtime)[2];

                                if ($thishour != $lasthour) {

                                        

                                        if ($schedule[$thishour]) {

                                                if (get_session() eq 
$nosession) {

                                                        my $cmd = '';

                                                        my $outfreq = 0;

                                                        if ($scheduler[0] eq 
'C' ) {

                                                                $cmd = 'H'; # 
set channel

                                                        } elsif ($scheduler[0] 
eq 'M' ) {

                                                                $cmd = 'E'; # 
set memory

                                                        } else {

                                                                $cmd = 'F';

                                                                $outfreq = 
$freqs[$mins] + $freq_corrections[$mins];

                                                        }

                                                        eval {

                                                                $error = 
`rigctl -m $rigtype -r $rigdevice -s $rigrate $cmd $outfreq` 

                                                                        or die 
"cannot use hamlib? $@\n";

                                                        };

                                                        if ($@) {

                                                                                
                print "Freq set error?\n";

                                                        }

                                                        

                                                }

                                        }

                                        $lasthour = $thishour;

                                }

                        }

####### scanner #################################







                        if ($scanner) {

                                scanner();

                        }

                        

####### beacon  ################################

                        my $minu = (time / 60 ) % 60;           # What minute 
is this ?

                        if ($minu>=0 && $minu <5){

                                serverbeacons();

                        }

                        

####### send aprs beacon #################################

                        

                        if ($Aprs_connect == 1) {

                                if (time() - $systime >= 60 * $posit_time) {    
                ## 10 mins aprs beacon...

                                        $systime = time();

                                        # now do what we want....



                                        my ($month, $hour, $min) = (gmtime) [3, 
2, 1];

                                        $month = substr (("0" . $month), -2, 2);

                                        $hour = substr (("0" . $hour), -2, 2);

                                        $min = substr (("0" . $min), -2, 2);

                                        

                                        my $mytime = $month . $hour . $min . 
"z";

                                        my $MSG = "$ServerCall" . ">PSKAPRS:" . 
"@" . $mytime . $Aprs_beacon . "\n";



                                        aprs_send ($MSG);

                                                                                

                                        # end

                                }

                        }

                }       # end if 'read'

        }       # end while loop

        

        close $reader;

        waitpid($pid, 0);

} else {

        die "Cannot fork: $!" unless defined $pid;

        close $reader;



        pskserver($ServerCall, "$Inputfile", "$output");



        close $writer;

        

        $error = `killall rflinkserver.pl`; # kill all children still 
running.....



        exit;   

}

$error = `killall rflinkserver.pl`; # kill all children still running.....



exit (1);







########################################################

sub pskserver { #               main, server

########################################################



my ($ServerCall, $Inputfile, $output) = @_;

$outputfile = substr ($output, 1);



my $STAT = "";

my $teststatus = "Listening";





`cp zb "$Inputfile"`;

`cp zb "$outputfile"`;



                $ConnectStatus = "Listening";



while (1) {

        logprint ("Listening to the radio\n");

        

        set_txstatus("TXDisconnect");   # just in case...

        send_frame();



        

        reset_arq();



                $ConnectStatus = "Listening";

        

        if ($ConnectStatus eq "Listening") {

        

                until (get_rxstatus() eq "Connect_req") { 

                        

                        if (get_session() eq $nosession) {

                                if (get_rxqueue()) {

                                        my $mystring = get_rxqueue();

                                        printf $writer ("%s", $mystring);

                                        reset_rxqueue();                        
                        

                                }

                        }

                        eval {

                                local $SIG{ALRM} = sub { die "alarm!!" };

                                alarm 10;

                                eval {

                                        listening(); 

                                };

                                alarm 0;

                        };

                        alarm 0;

                        die if $@ && $@ !~ /alarm!!/;

                        

                        sleep(1);

                        inc_idle();

                        if (get_rxstatus() eq "Poll_rx") {

                                set_txstatus("TXAbortreq");

                                send_frame();

                        }

                }

                

                if (get_rxstatus() eq "Connect_req") {

                        

                        $ConnectStatus = "Connected";

                        

                        # send connect_ack

                        set_txstatus("TXConnect_ack");

                        send_frame();



                        reset_arq();

                        my $Reconnect_possible = 0;

## we are now connected

                                        

                                        print $writer "~ABORTSEND\n";

                                        

                                        $call=get_call();

                                        

                                        if (index ($Usercalls, $call) < 0) {

                                                if (getuserdata ($call) ne 
"Unknown") {

                                                        $Usercalls .= $call;    
# add it to the list of users

                                                        $Usercalls .= " ";

                                                }elsif ($opensystem) {

                                                        $Usercalls .= $call;    
# add it to the list of users anyway

                                                        $Usercalls .= " ";

                                                        $Pop_host = "";         
                                                        

                                                        print "added call to 
list of known calls\n";

                                                        $usrmessage = "pse 
update your record!\n";                                      

                                                }

                                        } 

                                        

                                        $_ = $Usercalls;



                                        my @callfrags = split ("\/", $call);

                                        foreach my $frag(@callfrags) {

                                                if (m/$frag/) {         # from 
Usercalls list

                                                        if (length($frag) > 3) {

                                                                $call = $frag;

                                                                logprint ("Call 
$call o.k.\n"); 

                                                                open 
SESSIONDATA, ">PSKmailsession";

                                                                print 
SESSIONDATA $call;  # put it away safely

                                                                close 
SESSIONDATA;

                                                                sleep(2);

                                                                

                                                                my $mailcall = 
get_session();
                                                                
getuserdata($mailcall);



                                                                $sstate = "";

                                                                @ping = ();
                                                                if (-e 
".internet") { unlink ".internet";}

                                                                eval {          
                                                # check if internet present

                                                                        @ping = 
`ping -c 1 google.com 2>/dev/null`;

                                                                };

                                                                if($ping[1] && 
$ping[1] =~ /(time=\d*\.*\d* ms)/) {

                                                                        $sstate 
= "I";
                                                                        `touch 
.internet`;

                                                                }
                                                                
                                                                if (-e 
"./localmail/$mailcall") {       # see if there is local mail
                                                                        my 
$folder = Email::Folder->new("./localmail/$call");
                                                                        my 
$mails = "";
                                                                        my 
$count = 0;

                                                                        for my 
$msg ($folder->messages) {
                                                                                
$count++;
                                                                        }
                                                                        if 
($count) {
                                                                                
$sstate .= "L$count";
                                                                        }
                                                                }

                                                                if ($Pop_host 
&& -e ".internet") {      # check if interner mail

                                                                        my 
$count = 0;

                                                                        
$usrmessage = "";

                                                                        eval {

                                                                                
local $SIG{ALRM} = sub { die "alarm"};

                                                                                
alarm 20;

                                                                                
eval {

                                                                                
        $count = count_mail() ; # get mail from pop server

                        print "$count\n";

                                                                                
};

                                                                                
alarm 0;

                                                                        };

#                                                                       $count 
= 0 unless $count;

                                                                        alarm 0;

                                                                        if ($@ 
&& $@ =~ /alarm/) {

                                                                                
$usrmessage = " Timeout reading the mail...\n";

                                                                        } else {

                                                                                
        if ($count > 1) {

                                                                                
                $usrmessage = $count . " mails.\n";

                                                                                
        } elsif ($count ==1) {

                                                                                
                $usrmessage = $count . " email.\n";

                                                                                
        } elsif ($count < 0) {

                                                                                
                $usrmessage = "Could not list mail.\n";

                                                                                
        } else {

                                                                                
                $usrmessage = "No mail.\n";

                                                                                
        }

                                                                                
        if (-e "mailheaders") {unlink "mailheaders";}

                                                                        

                                                                        }

                                                                }
                                        if ($count) {$sstate .= "M" . $count};

                                                                                
                                                

                                                                if ($usrmessage 
!~ /Could not list mail/) {

                                                                        `echo 
"$ServerCall $Version-$sstate>\n" > TxInputfile`;

                                                                } else {

                                                                        `echo 
"$ServerCall $Version\nHi $call, pse update your record" > TxInputfile`;

                                                                }

                                                                $STAT = 
getuserdata($call);

                                                                last;

                                                        }

                                                } else {

                                                        `echo "Sorry, $call not 
registered...\n" > TxInputfile`;

                                                        sleep 10;

                                                }

                                        }



                                        $RxReady = 1;

                                        

                                        $Retries = 0;

                                        

                        while ($ConnectStatus eq "Connected") { # Connected 
loop...

                        

                                until (get_idle() > $Maxidle) {

                                        sleep(1);

                                        inc_idle();     # update idle counter

                                                                

                                        reset_rxstatus();

                                        

                                        eval {

                                                local $SIG{ALRM} = sub { die 
"Alarm!!" };

                                                alarm 10;

                                                eval {

                                                        listening(); 

                                                };

                                                alarm 0;

                                        };

                                        alarm 0;

                                        die if $@ && $@ !~ /Alarm!!/;

                                        

                                        $RxStatus = get_rxstatus();

                                        

                                        

                                        if (check_lastblock()) { 

                                                last; 

                                        }

                                }

                                $RxStatus = get_rxstatus();

                                
                                $txqlen = gettxtqueue();
                                
                                if ($RxStatus eq "Abort") {

                                        $ConnectStatus = "Listening";

                                        last;

                                } elsif ($RxStatus eq "Status_rx"){

                                        if ($txqlen) {
                                                $RxReady = 1;

                                                $Retries = 0;
                                        } else {
                                                $RxReady = 1;
                                                $Retries++;

                                        }

                                } elsif ($RxStatus eq "Poll_rx"){

                                                $RxReady = 0;

                                                $Retries++;
                                                set_txstatus ("TXStat");
                                                send_frame();
                                } elsif ($RxStatus eq "Connect_req"){

                                        $Reconnect_possible++;

                                        $Retries = 0;

                                        if ($Reconnect_possible >= 1) {

                                                $Reconnect_possible = 0;

                                                print "Reconnect received!!\n";

                                                $ConnectStatus = "Listening";

                                                last;

                                        }

                                } elsif ($RxStatus eq "Disconnect_req"){

                                        disconnect();

                                        set_txstatus("TXDisconnect");

                                        send_frame();



                                        reset_rxstatus;

                                        $ConnectStatus = "Listening";

                                        $Retries = $Max_retries;

                                } 



                                my $mystring = get_rxqueue();

                                printf $writer ("%s", $mystring);
                                if ($mystring) {
                                        $Retries = 0;
                                }

                                reset_rxqueue();                        

                                

                                $Maxidle = get_maxidle();

# send next frame





                                inc_idle();

                                

                                my $session_status = get_session();

                                if ($session_status eq "none" || 
$session_status eq "beacon") {

                                        last;   # outta here...

                                }

                                

                                if (get_idle() > $Maxidle) {    # send poll 
frame

                                        set_txstatus("TXPoll");

                                        send_frame();

                                        $Retries++;

                                        $RxReady = 0;

                                } 

                                if ($RxReady == 1 ) {   

                                        $RxReady = 0;

                                        if ($txqlen) {
                                                $Retries = 0;
                                        }

                                        $outputstring = gettxinput();

                                        set_txstatus("TXTraffic");

                                        send_frame($outputstring);
                                        if ($outputstring) {
                                                $Retries = 0;
                                        }

                                        $outputstring = "";

                                }

                                if ($Retries >= $Max_retries) {

                                        set_txstatus("TXDisconnect");

                                        send_frame();

                                        disconnect();

                                        $ConnectStatus = "Listening";

                                        reset_rxstatus;

                                        $ConnectStatus = "Listening";

                                        $Retries = 0;

                                }

                                

                                if ($ConnectStatus ne "Connected") {

                                        print "Disconnected\n";

                                        open SESSIONDATA, ">PSKmailsession";

                                        print SESSIONDATA $nosession;

                                        close SESSIONDATA;

                                        $ConnectStatus = "Listening";

                                        last;

                                }

                        }

## connect ended

                        

                }



        }

}

}



########################################################

sub get_serverstatus {

########################################################

                

                return $ConnectStatus;

}



########################################################

sub count_mail {

#######################################

my $validconnect = 0;

$stationname = get_session();



getuserdata($stationname);





if ($Pop_host =~ /gmail/i) {

        $Use_ssl = 1;

}



if ($Use_ssl) {

        $gmailuser = $Pop_user . "@" . "gmail.com";

} else {

        $gmailuser = $Pop_user;

}



my $pop = new Mail::POP3Client (USER            => $Pop_user,

                                                                PASSWORD        
=> $Pop_pass,

                                                                HOST            
=> $Pop_host,

                                                                USESSL          
=> $Use_ssl,

                                                                );

$count = $pop->Count();



if ($count > -1) {

        $pop->Reset;

}

return $count;

}



########################################################

sub list_mail {

#######################################

my $validconnect = 0;

my $hdr = "";

my $pop = "";



$stationname = get_session();



getuserdata($stationname);



if ($debug_mail) {print "$Pop_host|\n";}



if ($Pop_host =~ /gmail/i) {

        $Use_ssl = 1;

}



if ($Use_ssl) {

        $gmailuser = $Pop_user . "@" . "gmail.com";

} else {

        $gmailuser = $Pop_user;

}



print "USER=$gmailuser\n";



        $pop = new Mail::POP3Client (USER               => $gmailuser,

                                                                PASSWORD        
=> $Pop_pass,

                                                                HOST            
=> $Pop_host,

                                                                USESSL          
=> $Use_ssl,

                                                                );





        if ($pop->Count() > -1) { 

                logprint ("Pop defined\n"); 

                $validconnect = 1;

        }



        if ($debug_mail) {print "$Pop_user,$Pop_pass|\n";}





        if ($validconnect) {logprint ("Authenticated\n");}



        $Count = $pop->Count;

        print "Count=$Count\n";



                

        if ($Count) { 

                logprint ("Got message list\n");

                `echo '' > $mailuser`;

        };

                        

        open (HFH, ">mailheaders"); 

        open (MFH, ">>$mailuser");      



        print HFH "\n";

        print MFH "\n";

                

        for ($i =1; $i <= $Count; $i++) {

                my (@msg, $subject, $sender, $from);

                my $headerlength = 0;

                                

                @msg = $pop->Head($i);

                

                $subject = $sender = '';

                

                foreach $hdr (@msg) { 



                        $headerlength += length ($hdr);

                        

                        if ($hdr =~ /^Subject:\s+/i)    { 

                                $subject = substr($hdr, 8);

                        }

                        if ($hdr =~ /^From:\s+/i)       { 

                                $sender = substr($hdr, 6); 

                                        ($from = $sender) =~ s{<.*>}{};

                                        if ($from =~ m{\(.*\)}) {$from = $hdr; }

                                        $from ||= $sender;

                        }

                }

                

                my $messagecontent = $pop->Head($i, 999);



                my $mesglength = length ($messagecontent) - ($headerlength + 
100);



                my $headerline = sprintf ("%2.0d %-30.30s %-60.60s %d\n", $i, 
$from, $subject, $mesglength);

                print HFH $headerline;

                if ($monitor && $debug_mail) {

                        print $headerline;

                }

                my $fromline = sprintf ("%-20.20s %2.0d %-55.55s ", $from, $i, 
$subject);



                        print MFH "From $fromline $mesglength Bytes\n";

                        print MFH @$messagecontent;

                

                

                $mymailnumber = $i;



        }



        print HFH "\n";

        print MFH "\n";



        close (HFH);

        close (MFH);



        $pop->Close; # keep the mail for the moment









} # end list_mail



########################################################

sub read_mail {

#######################################



my @numbers = @_;



my $fault = 0;

my $gmailuser = "";

my $messagecontent;

my $pop;



getuserdata(get_session());



if ($Pop_host =~ /gmail/i) {

        $Use_ssl = 1;

}



if ($Use_ssl) {

        $gmailuser = $Pop_user . "@" . "gmail.com";

} else {

        $gmailuser = $Pop_user;

}



print "USER=$gmailuser\n";



        $pop = new Mail::POP3Client (USER               => $gmailuser,

                                                                PASSWORD        
=> $Pop_pass,

                                                                HOST            
=> $Pop_host,

                                                                USESSL          
=> $Use_ssl,

                                                                );

        

 `echo '' > $mailuser` ;

                

open (MFH, ">>$mailuser");      

        

foreach my $msgid (@numbers) {

        my (@msg, $subject, $sender, $from, $dte);



        if ($msgid !~ /\d+/) { next; }  

        

                if ($gmailuser) {

                        $messagecontent = $pop->Head($msgid, 999);

                } else {

                        $messagecontent = $pop->HeadAndBody($msgid);

                } 

                if ($messagecontent) {

                        print MFH "\n\nFrom \n";

                        print MFH $messagecontent;

                } else {

                        if ($monitor) {

                                print "failed \n";

                        }

                        `echo "Message not available\n"`;

                }

        

        $mymailnumber = $msgid;

}



close (MFH);



$pop->Reset; # keep the mail for the moment









} # end read_mail



#####################################################

sub delete_mail {

#####################################################



my @delmessages = @_;



getuserdata(get_session());



if ($Pop_host =~ /gmail/i) {

        $Use_ssl = 1;

}



if ($Use_ssl) {

        $gmailuser = $Pop_user . "@" . "gmail.com";

} else {

        $gmailuser = $Pop_user;

}



my $pop = new Mail::POP3Client (USER            => $Pop_user,

                                PASSWORD        => $Pop_pass,

                                HOST            => $Pop_host,

                                USESSL          => $Use_ssl,);





foreach $msgid(@delmessages) {

        if ($msgid) {

                $pop->Delete($msgid) ;

        }

}

$pop->Close;



} # end delete_mail



#####################################################

sub getuserdata {

#####################################################

        tie (%db, "DB_File", $dbfile) 

                or die "Cannot open user database\n";

                

        tie (%visitors, "DB_File", ".visitors")

                or die "Cannot open visitors database\n";

        

        $key = shift @_;

        if (exists $db{$key}) {

                 $Value = $db{$key};

        } else {



                my $record; 

                eval {

                        local $SIG{ALRM} = sub { die "timeout" };

                        alarm 10;

                        eval {

                                $record = `elinks -dump -dump-width 120 
$dbaddress$ServerCall:$dbpass:$key 2>/dev/null` or die; 

                        };

                };

                alarm 0;

                if ($@ && $@ =~ /timeout/){

                        return "Unknown";

                }

                if (length $record < 13 ) {

                        print "Could not find record\n";

                        $Pop_host = "";

                        return ("Unknown");

                } else {

                        $record =~ m/(\w.*)END/;

                        $record = $1;

                        my @dbvalues= split ", ", $record;

                        

                        if ($dbvalues[2] =~ /(.*)\@/) {

                                $dbvalues[2] = $1;

                        }

                        

                        $Value = $dbvalues[1] . ","     # host

                                . $dbvalues[2] . ","    # user

                                . $dbvalues[3] . ","    # pass

                                . $relay . ","                  # smtp

                                . $dbvalues[5] . ","    # from

                                . $mailuser . ","               # mailuser file

                                . $dbvalues[4];

                        $db{$key} = $Value;                     # set record in 
db

                        

                        $visitors{$key} = time;

                                                

                }

        }



                my @values = split (/,/ , $Value);

                

        $Pop_host = shift @values;

        $Pop_user = shift @values;

        if ($Pop_user =~ /(.*)\@/) {

                $Pop_user = $1;

        }

        $Pop_pass = shift @values;

#       $relay = shift @values;

        my $dump = shift @values;

        $address = shift @values;

        $mailuser = shift @values;

        $findupasswd = shift @values;

                

        foreach $key (keys %visitors) {

                if (time - $visitors{$key} > 130000) {

                        delete $visitors{$key}; # give them 36 hours...

                        delete $db{$key};

                }

        }

        

        untie %db;

        untie %visitors;

        return @values; 

}

#########################################################

sub getusercalls {

#########################################################



        tie (%db, "DB_File", $dbfile) 

                or die "Cannot open user database\n";



        $Usercalls = "";

        foreach my $callkey (keys %db) {

                $Usercalls .= $callkey;

                $Usercalls .= " ";

        }

        untie %db;



}

#end

################################

sub filter {

################################

# in = $mailuser, out = mailfile

################################



my $inputfile = shift @_;

my $html = shift @_;



my @fromarray;

my @subjectarray;

my $datearray;

my @headerarray;

my $counter = -1;

my $line;

my @testarray = ();

@msgarray = ();

my @craps = ();



init_crap_filter ();    # fills craps array with text scraps



open (INP, $inputfile);

my @mailtest = <INP>;

close (INP);



my $quiet = 1;

my $subjdone = 0;

my $datedone = 0;

my $fromdone = 0;



my $mesgstart = 0;

foreach $line (@mailtest) {

        

$line =~ s/\015//g;



$_ = $line;



                if (m/^From /) {

                        $quiet = 1;

                        $counter++;

                        $subjdone = 0;

                        $datedone = 0;

                        $fromdone = 0;

                        $mesgstart = 1;

#                       $msgarray[$counter] .= $line;

                        if ($monitor) {

                                print $line;    ##debug

                        }





                }

                

                next unless $mesgstart;

                

                if ($line eq "\n" || $line eq "\r\n") {

                        if ($counter >= 0) { $msgarray[$counter] .= $line; }

                        $quiet = 0;



                        if ($monitor) {

                                print $line;    ##debug

                        }

                }

                if (m/^From: / && $fromdone == 0) {

                        if ($counter >= 0) { $msgarray[$counter] .= $line; }

                        $fromdone = 1;

                        if ($monitor) {

                                print $line;    ##debug

                        }

                                

                }

                elsif (m/^Subject:/ && $subjdone == 0) {

                        if ($counter >= 0) { $msgarray[$counter] .= $line; }

                        if ($counter >= 0) { $subjectarray[$counter] .= $line; }

                        $subjdone = 1;

                        if ($monitor) {

                                print $line;    ##debug

                        }

                }

                elsif (m/^Date:/ && $datedone == 0) {

                        if ($counter >= 0) { $msgarray[$counter] .= $line; }

                        $datedone = 1;          

                        if ($monitor) {

                                print $line;    ##debug

                        }

                } else {

                        if ($quiet == 0) {

                                if ($counter >= 0) {

                                        $line =~ s/\n\n/\n/;

                                        $line =~ s/\r\n/\n/; 

                                        $msgarray[$counter] .= $line; 

                                }

                        if ($monitor) {

                                print $line;    ##debug

                        }

                        }

                }       

}



open (OUTP, ">mailin");

print OUTP @msgarray;

close (OUTP);



open (MAILF, "mailin");         # html filter

open (MAILOUT, ">mailfile");



while (<MAILF>) {

        if ($html == 0 && m#<HTML#i ... m#</HTML#i) {

                if ($monitor) {

                        print $_;

                }

         } else {

                my $in = crapfilter ($_);

                print MAILOUT $in;

         } 

}

close (MAILOUT);

close (MAILF);



`cp mailfile mailtest`;



} #end filter



################################################

sub crapfilter {

################################################

        my      $line = shift @_;



        

        if ($craps[0]) {

                

                $line =~ s/=\?\?Q\?//;

                $line =~ s/\?Q\?//;

                $line =~ s/\?iso-8859-1\?q\?//;

                $line =~ s/=\?iso-8859-1\?Q\?//;

                $line =~ s/=09//;

                $line =~ s/=20//;

                $line =~ s/=22//;

                $line =~ tr/\r//;

                $line =~ s/^\s+\n/\n/;



                if ($line =~ /^>/ ) {

                        return ("");

                }

                

                foreach $scrap (@craps) {

                        chomp $scrap;

                        if ($line =~ /$scrap/) {

                                return ("");

                        } 

                }

                

        }

        

        return $line;

}

#################################################################

sub init_crap_filter {  # fills array with text scraps

#################################################################

        if (-e "crapmail.txt") {

                open ($nfh, "crapmail.txt");

                @craps = <$nfh>;

                close ($nfh);

        } else {

                print "Can not find file: crapmail.txt\n";

        } 

}

#################################################################

############################################################

# Function for sending mail for systems without an MTA

sub send_mail {

############################################################

     my($to, $from, $subject, @body)= @_;



        my $mycall = get_session();

print "Mycall =$mycall\n";

        getuserdata($mycall);

logprint ("RELAY=$relay|\n");

    my $smtp = Net::SMTP->new($relay, Debug => $debug_mail);

    die "Could not open connection: $!" if (! defined $smtp);



    $smtp->mail($from);

    $smtp->to($to);

    $smtp->data();

    $smtp->datasend("To: $to\n");

    $smtp->datasend("From: $address\n");

        $smtp->datasend("Subject: $subject\n");

        $smtp->datasend("\r\n");

    foreach(@body) {

         $smtp->datasend("$_\n");

    }

    $smtp->dataend(); 

    $smtp->quit;

}

########### end smtp ######################



###########################################

sub get_session {

###########################################

        open SESSIONDATA, "PSKmailsession";

        my $session = <SESSIONDATA>;

        chomp $session;

        close SESSIONDATA;

        

        return $session;

}

##############################################

sub scanner {

##############################################



        $hour = (time / 3600) % 24;

        if ($hour != $oldhour) {

                

                if (-e "./qrg/freqs.txt") {

                        open ($fh, $qrgfile) or die "Cannot open the scanner 
file!";

                        @freqhrs = <$fh>;

                        close ($fh);

                        

                        $cat = $freqhrs[0];

                        print $cat;

                        chomp $cat;

                        

                        @freqs = split (",", $cat);

                        my $pskmodes = $freqhrs[1];

                        print $pskmodes, "\n";

                        @modes = split (",",$pskmodes);

                }

                $oldhour = $hour;

        }





        $mins = ((time / 60) + $freq_offset) % 5 ;

        if ($mins != $oldmins) {

                if (get_session() eq $nosession) {

                        my $cmd = '';

                        my $outfreq = 0;

                        if ($scanner eq 'C' ) {

                                $cmd = 'H'; # set channel

                        } elsif ($scanner eq 'M' ) {

                                $cmd = 'E'; # set memory

                                $outfreq = $freqs[$mins];

                                $modem = $modes[$mins];

                        } else {

                                $cmd = 'F';

                                $outfreq = $freqs[$mins] + 
$freq_corrections[$mins];

                                $modem = $modes[$mins];

                        }

                        eval {

                                #print `rigctl -m $rigtype -r $rigdevice -s 
$rigrate $cmd $outfreq`;

                                $error = `rigctl -m $rigtype -r $rigdevice -s 
$rigrate $cmd $outfreq` 

                                        or die "cannot use hamlib? $@\n";

                        };

                        if ($@) {

                                #                               print "Freq set 
error?\n";

                                #                               print 
"$error\n";

                        }

                        #print "rigctl -m $rigtype -r $rigdevice -s $rigrate 
$cmd $outfreq";

                        setmode($modem); # set fldigi mode

#                       set_autotune(1); # Remember that a fq change has taken 
place                                    

                }

                }

                $oldmins = $mins;

#       }

}





##############################################

sub oldserverbeacon {

##############################################

        my $realmin = (time / 60 ) % 60;

        if ($realmin == $Beaconminute && $Beacon_sent == 0) {

                sleep 1; # settle the tx

                # send beacon

                print "Sending beacon\n";

                set_txstatus("TXBeacon");

                send_frame();

                $Beacon_sent = 1;

        }

        elsif ($realmin == $Beaconminute+1){

                $Beacon_sent = 0;

        }       

}



##############################################

# Check the beacons array and send a beacon if the current minute is 0-4 (array 
size)

# and that array segment is 1. Update the status array to reflect beacon sent 
status.

# 2007-01-19, SM0RWO/Pär Crusefalk

sub serverbeacons {

##############################################

        my $trigger = 0;                                # set to 1 if its time 
for a beacon

        my $n = 0;                                      # Used to loop the 
arrays

        my $realmin = (time / 60 ) % 60;                # What minute is this ?



        # Loop the array, this is potentially dangerous if the array is not

        # set according to spec (should check that).

#       while ($Beaconarray[$n])

        foreach (@Beaconarray) 

        {

                if ($realmin == $n)

                { 

                        if ($Beacons_sent[$n] == 0 && $_ == 1) 

                        {

                                $trigger=1;                     # Time for a 
beacon

                                $Beacons_sent[$n]=1;            # Set the 
current minute as done

                        }

                        $Beacons_sent[$n-1]=0;                  # Set the 
minute before (or wrap around) as unsent

                        #print "Minut: $realmin  sent: @Beacons_sent 
Beaconarray: @Beaconarray..\n";

                }

                $n++;

        }



        # Send the beacon if triggered and no session

        if ($trigger == 1 && get_session() eq $nosession)

        {

                sleep 1; # settle the tx

                # send beacon

                print "Sending beacon\n";

                set_txstatus("TXBeacon");

                send_frame();

        }

}



################################################

sub setmode {

################################################

#return # temporarily

my $pskmode =shift @_;

my $modemstring = "\<cmd\>\<mode\>" . $pskmode . "\</mode\>\</cmd\>\n";



#print $modemstring;



open (CMDOUT, $output);

print CMDOUT $modemstring;

close (CMDOUT);

open (CMDOUT, ">.modem");

print CMDOUT $modemstring;

close (CMDOUT);

}

################################################

sub getbeacons {

################################################



my $ClientCall = shift @_;

`cat server.log | grep "$ClientCall" > .mylines`;



my $now = time();

my $then = time();

$then -= 60 * 60 * 12;

my %beaconhours = ();



my $j = int ($then/(3600) % 24);

my $k = int ($now/(3600) % 24);

my $m = 0;



if ($j > $k) {

        $k += 24;

        $m = 1;

}



for (my $i = $j; $i <= $k; $i += 1) {

        $beaconhours{$i} = 0;

}



open (LOG, ".mylines");

while (my $input = <LOG>) {

        if ($input =~ /((\d\d):(\d\d)\s\w*\s(\w\w\w)-(\d*)-(\d\d\d\d): 
<SOH>..u\S*:26 .\d\d\d\d\.\d\d\w)/) {

                my $month = monthnumber($4);

                my $hour = $2;

                my $mins = $3;

                my $epoch = timegm (0, $mins, $hour, $5, $month,  $6);

                if ($epoch > $then) {

                        my $beaconhour = int ($epoch/(3600) % 24);

                        if ($m && $beaconhour < 13) { $beaconhour += 24;}

                        $beaconhours{$beaconhour}++;

                }

        }

}

close (LOG);



my $index;

my $b_outstring = "";



foreach my $beacon(sort {$a <=> $b} keys %beaconhours) {

        if ($beacon > 23) {

                $index = $beacon - 24;

        } else {

                $index = $beacon;

        }

        $b_outstring .= $beaconhours{$beacon};

}

        $b_outstring .= "|";

        $b_outstring .= $index;

        $b_outstring .= " UTC\n";

        

        return $b_outstring;

} # end



###############################################

sub monthnumber {

###############################################

        my $mon = shift @_;

        my $count = 0;

        my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

        foreach $month (@months) {

                if ($month =~ /$mon/i) {

                        last;

                }

                $count++;

        }

        return $count;

} # end

###############################################


############################################### Check the beacons array and 
send a beacon if the current minute is 0-4 (array size)# and that array segment 
is 1. Update the status array to reflect beacon sent status.# 2007-01-19, 
SM0RWO/Pär Crusefalksub serverbeacons 
{############################################## my $trigger = 0;                
                # set to 1 if its time for a beacon     my $n = 0;              
                        # Used to loop the arrays       my $realmin = (time / 
60 ) % 60;                # What minute is this ? # Loop the array of beacon 
minutes      foreach (@Beaconarray)  {               if ($realmin == $n)        
     {                       if ($Beacons_sent[$n] == 0 && $_ == 1)             
     {                               $trigger=1;                     # Time for 
a beacon                             $Beacons_sent[$n]=1;            # Set the 
current minute as done                        }                       
$Beacons_sent[$n-1]=0;                  # Set the minute before (or wrap 
around) as unsent              }               $n++;   }       # Send the 
beacon if triggered and no session   if ($trigger == 1 && get_session() eq 
$nosession)       {               sleep 1; # settle the tx                # 
send beacon           print "Sending beacon\n";               
set_txstatus("TXBeacon");               
 send_frame();  }}

Other related posts: