+16Aug16=======================================================================
+1. Mega change to push all local data in $root/local_data and where there
+ is duplication with system data (still in $root/data) then use whichever
+ is newer. This will move stuff (permanently) like spots and other DXLog
+ files to local_data as well as the userfile, DX QSL file and usdb stuff.
25Jul16=======================================================================
1. Add some timing stats to cmd spawn_cmd.
08Jul16=======================================================================
return (1, $self->msg('e5')) if $self->inscript;
# log out text
-if ($self->is_user && -e "$main::data/logout") {
- open(I, "$main::data/logout") or confess;
+if ($self->is_user && -e localdata("logout")) {
+ open(I, localdata("logout")) or confess;
my @in = <I>;
close(I);
$self->send_now('D', @in);
# create and edit the one in /spider/local_cmd/crontab
# for doing connections and things
#
-1 0 * * 3 DXUser::export("$main::data/user_asc")
+1 0 * * 3 DXUser::export(localdata("user_asc"))
5 0 * * * DXDebug::dbgclean()
0 3 * * * Spot::daily()
#
#
my $self = shift;
-my $line = shift || "$main::data/user_asc";
+my $line = shift || localdata("user_asc");
return (1, $self->msg('e5')) unless $self->priv >= 9;
my ($fn, $flag) = split /\s+/, $line;
use vars qw($badword $regexcode);
-my $oldfn = "$main::data/badwords";
-my $regex = "$main::data/badw_regex";
-my $bwfn = "$main::data/badword";
+my $oldfn = localdata("badwords");
+my $regex = localdata("badw_regex");
+my $bwfn = localdata("badword");
# copy issue ones across
filecopy("$regex.gb.issue", $regex) unless -e $regex;
%bands = (); # the 'raw' band data
%regions = (); # list of regions for shortcuts eg vhf ssb
%aliases = (); # list of aliases
-$bandsfn = "$main::data/bands.pl";
+$bandsfn = localdata("bands.pl");
%valid = (
cw => '0,CW,parraypairs',
$default = 48*24*60*60;
$lasttime = 0;
-$fn = "$main::data/dupefile";
+localdata_mv("dupefile");
+$fn = localdata("dupefile");
sub init
{
# Things entered into the list are always upper
# cased.
#
-# The files that are created live in /spider/data
+# The files that are created live in /spider/local_data (was data)
#
# Dunno why I didn't do this earlier but heyho..
#
sub new
{
my ($pkg, $name) = @_;
- my $s = readfilestr($main::data, $name);
+
+ # move existing file
+ localdata_mv($name);
+ my $s = readfilestr($main::local_data, $name);
my $self = undef;
$self = eval $s if $s;
dbg("error in reading $name in DXHash $@") if $@;
sub put
{
my $self = shift;
- writefilestr($main::data, $self->{name}, undef, $self);
+ writefilestr($main::local_data, $self->{name}, undef, $self);
}
sub add
{
my ($prefix, $suffix, $sort) = @_;
my $ref = bless {}, __PACKAGE__;
- $ref->{prefix} = "$main::data/$prefix";
+ localdata_mv($prefix);
+ $ref->{prefix} = "$main::local_data/$prefix";
$ref->{suffix} = $suffix if $suffix;
$ref->{sort} = $sort;
sub init
{
- do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
+ my $fn = localdata("hop_table.pl");
+ do $fn if -e $fn;
confess $@ if $@;
my $user = DXUser::get($main::mycall);
use DXDebug;
use DXUtil;
use LRU;
+use File::Copy;
use strict;
#
sub init
{
- my ($pkg, $fn, $mode) = @_;
+ my $mode = shift;
- confess "need a filename in User" if !$fn;
-
my $ufn;
my $convert;
require Storable;
};
-# eval "use Storable qw(nfreeze thaw)";
+ my $fn = "users";
if ($@) {
- $ufn = "$fn.v2";
+ $ufn = localdata("users.v2");
$v3 = $convert = 0;
dbg("the module Storable appears to be missing!!");
dbg("trying to continue in compatibility mode (this may fail)");
} else {
import Storable qw(nfreeze thaw);
- $ufn = "$fn.v3";
+ $ufn = localdata("users.v3");
$v3 = 1;
- $convert++ if -e "$fn.v2" && !-e $ufn;
+ $convert++ if -e localdata("users.v2") && !-e $ufn;
}
if ($mode) {
my %oldu;
dbg("Converting the User File to V3 ");
dbg("This will take a while, I suggest you go and have cup of strong tea");
- my $odbm = tie (%oldu, 'DB_File', "$fn.v2", O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v2 ($!) [rebuild it from user_asc?]";
+ my $odbm = tie (%oldu, 'DB_File', localdata("users.v2"), O_RDONLY, 0666, $DB_BTREE) or confess "can't open user file: $fn.v2 ($!) [rebuild it from user_asc?]";
for ($action = R_FIRST; !$odbm->seq($key, $val, $action); $action = R_NEXT) {
my $ref = asc_decode($val);
if ($ref) {
sub del_file
{
- my ($pkg, $fn) = @_;
-
- confess "need a filename in User" if !$fn;
+ my $fn = localdata("users");
$fn .= $v3 ? ".v3" : ".v2";
unlink $fn;
}
# try to detect a lockfile (this isn't atomic but
# should do for now
- $lockfn = "$root/local/cluster.lck"; # lock file name
+ $lockfn = "$root/local_data/cluster.lck"; # lock file name
if (-e $lockfn) {
open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
my $pid = <CLLOCK>;
package DXUser;
-use DXVars;
+use SysVar;
use DXUser;
if (@ARGV) {
print "user filename now $userfn\n";
}
-DXUser->del_file($main::userfn);
-DXUser->init($main::userfn, 1);
+DXUser::del_file();
+DXUser::init();
%u = ();
my $count = 0;
my $err = 0;
$err++
}
}
-DXUser->sync; DXUser->finish;
+DXUser::sync; DXUser::finish;
print "There are $count user records and $err errors\n";
};
print $fh "__DATA__\n";
package DXUtil;
+
use Date::Parse;
use IO::File;
use File::Copy;
use Data::Dumper;
+
use strict;
use vars qw(@month %patmap $pi $d2r $r2d @ISA @EXPORT);
filecopy ptimelist
print_all_fields cltounix unpad is_callsign is_long_callsign is_latlong
is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem
- is_prefix dd is_ipaddr $pi $d2r $r2d
+ is_prefix dd is_ipaddr $pi $d2r $r2d localdata localdata_mv
);
return $n - @$list;
}
+# find the correct local_data directory
+# basically, if there is a local_data directory with this filename and it is younger than the
+# equivalent one in the (system) data directory then return that name rather than the system one
+sub localdata
+{
+ my $ifn = shift;
+ my $ofn = "$main::data/$ifn";
+ my $tfn;
+
+ if (-e "$main::local_data") {
+ $tfn = "main::local_data/$ifn";
+ if (-e $tfn && -M $tfn < -M $ofn) {
+ $ofn = $tfn;
+ }
+ }
+
+ return $ofn;
+}
+
+# move a file or a directory from data -> local_data if isn't there already
+sub localdata_mv
+{
+ my $ifn = shift;
+ if (-e "$main::data/$ifn" ) {
+ unless (-e "$main::local_data/$ifn") {
+ move("$main::data/$ifn", "$main::local_data/$ifn") or die "localdata_mv: cannot move $ifn from '$main::data' -> '$main::local_data' $!\n";
+ }
+ }
+}
+
# the interval between unsolicited prompts if not traffic
$user_interval = 11*60;
-# data files live in
-$data = "$root/data";
-
-# system files live in
-$system = "$root/sys";
-
-# command files live in
-$cmd = "$root/cmd";
-
-# local command files live in (and overide $cmd)
-$localcmd = "$root/local_cmd";
-
-# where the user data lives
-$userfn = "$data/users";
-
-# the "message of the day" file
-$motd = "$data/motd";
# are we debugging ?
@debug = qw(chan state msg cron connect);
delete $conn->{timeout};
$conn->{csort} = $sort;
&{$conn->{rproc}}($conn, "$dir$call|$sort");
- $conn->_send_file("$main::data/connected") unless $conn->{outgoing};
+ $conn->_send_file(localdata("connected")) unless $conn->{outgoing};
}
sub new_client {
my $conn = $server_conn->SUPER::new_client($client);
# send login prompt
$conn->{state} = 'WL';
- $conn->_send_file("$main::data/issue");
+ $conn->_send_file(localdata("issue"));
$conn->send_raw("login: ");
$conn->_dotimeout(60);
$conn->{echo} = 1;
$duplth = 20; # the length of text to use in the deduping
$dupage = 12*3600; # the length of time to hold spot dups
-$dirprefix = "$main::data/wwv";
+$dirprefix = "$main::local_data/wwv";
$param = "$dirprefix/param";
$filterdef = bless ([
# tie the main prefix database
eval {$db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0664, $DB_BTREE);};
my $out = "$@($!)" if !$db || $@ ;
- eval {do "$main::data/prefix_data.pl" if !$out; };
+ my $fn = localdata("prefix_data.pl");
+ eval {do $fn if !$out; };
$out .= $@ if $@;
$lru = LRU->newbase('Prefix', $lrusize);
{
my ($k, $l);
my $fh = new IO::File;
- my $fn = "$main::data/prefix_data.pl";
+ my $fn = localdata("prefix_data.pl");
confess "Prefix system not started" if !$db;
$qslfn = 'qsl';
$dbm = undef;
+localdata_mv("$qslfn.v1");
+
sub init
{
my $mode = shift;
- my $ufn = "$main::root/data/$qslfn.v1";
+ my $ufn = localdata("$qslfn.v1");
Prefix::load() unless Prefix::loaded();
--- /dev/null
+# These are a load of system variables that used to live in DXVars.pm.
+#
+# They have been broken out into a separate module which must be called AFTER 'use DXVars' if that is in fact called at all.
+#
+# It is a replacement for DXVars.pm wherever it is used just for these paths
+#
+
+package main;
+use warnings;
+
+##
+## DXVars.pm overrides
+##
+# data files live in
+$data = "$root/data";
+
+# for local data
+$local_data = "$root/local_data";
+
+# system files live in (except they don't, not really)
+$system = "$root/sys";
+
+# command files live in
+$cmd = "$root/cmd";
+
+# local command files live in (and overide $cmd)
+$localcmd = "$root/local_cmd";
+
+# data files live in
+$data = "$root/data";
+
+# for local data
+$local_data = "$root/local_data";
+
+# where the user data lives
+$userfn = "$local_data/users";
+
+# the "message of the day" file
+$motd = "$local_data/motd";
use DB_File;
use File::Copy;
use DXDebug;
+use DXUtil;
+
#use Compress::Zlib;
use vars qw(%db $present $dbfn);
-$dbfn = "$main::data/usdb.v1";
+localdata_mv("usdb.v1");
+$dbfn = localdata("usdb.v1");
sub init
{
$duplth = 20; # the length of text to use in the deduping
$dupage = 12*3600; # the length of time to hold spot dups
-$dirprefix = "$main::data/wcy";
+$dirprefix = "$main::local_data/wcy";
$param = "$dirprefix/param";
$filterdef = bless ([
['origin_zone', 'nz', 19],
], 'Filter::Cmd');
-
sub init
{
$fp = DXLog::new('wcy', 'dat', 'm');
#
#
+package main;
+
require 5.10.1;
use warnings;
die "$root/local doesn't exist, please RTFM" unless -d "$root/local";
die "$root/local/DXVars.pm doesn't exist, please RTFM" unless -e "$root/local/DXVars.pm";
- mkdir "$root/local_cmd", 0777 unless -d "$root/local_cmd";
-
+ # create some directories
+ mkdir "$root/local_cmd", 02777 unless -d "$root/local_cmd";
+ mkdir "$root/local_data", 02777 unless -d "$root/local_data";
# try to create and lock a lockfile (this isn't atomic but
# should do for now
- $lockfn = "$root/local/cluster.lck"; # lock file name
+ $lockfn = "$root/local_data/cluster.lck"; # lock file name
if (-w $lockfn) {
open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
my $pid = <CLLOCK>;
use Mojo::IOLoop;
use DXVars;
+use SysVar;
+
use Msg;
use IntMsg;
use Internet;
our $broadcast_debug; # allow broadcasting of debug info down "enhanced" user connections
-
# send a message to call on conn and disconnect
sub already_conn
{
}
STDOUT->autoflush(1);
+
# try to load the database
if (DXSql::init($dsn)) {
$dbh = DXSql->new($dsn);
# initialise User file system
dbg("loading user file system ...");
- DXUser->init($userfn, 1);
+ DXUser::init(1);
# look for the sysop and the alias user and complain if they aren't there
{
use Mojo::IOLoop;
+use DXVars;
+use SysVar;
+
use Msg;
use IntMsg;
-use DXVars;
use DXDebug;
use DXUtil;
use DXDebug;
+++ /dev/null
-#!/usr/bin/env perl
-#
-# Export the user file in a form that can be directly imported
-# back with a do statement
-#
-
-require 5.004;
-
-# search local then perl directories
-BEGIN {
- umask 002;
-
- # root of directory tree for this system
- $root = "/spider";
- $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
-
- unshift @INC, "$root/perl"; # this IS the right way round!
- unshift @INC, "$root/local";
-}
-
-use DXVars;
-use DB_File;
-use Fcntl;
-use Carp;
-
-$userfn = $ARGV[0] if @ARGV;
-unless ($userfn) {
- croak "need a filename";
-}
-
-DXUser->init($userfn);
-unlink "$userfn.asc";
-open OUT, ">$userfn.asc" or die;
-
-%newu = ();
-$t = scalar localtime;
-print OUT "#!/usr/bin/perl
-#
-# The exported userfile for a DXSpider System
-#
-# Input file: $userfn
-# Time: $t
-#
-
-package DXUser;
-
-%u = (
-";
-
-@all = DXUser::get_all_calls();
-
-for $a (@all) {
- my $ref = DXUser::get($a);
- my $s = $ref->encode() if $ref;
- print OUT "'$a' => q{$s},\n" if $a;
- $count++;
-}
-
-DXUser->finish();
-
-print OUT ");
-#
-# there were $count records
-#\n";
-
- close(OUT);
-
-exit(0);
-
-
-package DXUser;
-
-
-use MLDBM qw(DB_File);
-use Fcntl;
-use Carp;
-
-#
-# initialise the system
-#
-sub init
-{
- my ($pkg, $fn, $mode) = @_;
-
- confess "need a filename in User" if !$fn;
- if ($mode) {
- $dbm = tie (%u, MLDBM, $fn, O_CREAT|O_RDWR, 0666) or confess "can't open user file: $fn ($!)";
- } else {
- $dbm = tie (%u, MLDBM, $fn, O_RDONLY) or confess "can't open user file: $fn ($!)";
- }
-
- $filename = $fn;
-}
-
-#
-# close the system
-#
-
-sub finish
-{
- untie %u;
-}
-
-#
-# get - get an existing user - this seems to return a different reference everytime it is
-# called - see below
-#
-
-sub get
-{
- my $pkg = shift;
- my $call = uc shift;
- # $call =~ s/-\d+$//o; # strip ssid
- return $u{$call};
-}
-
-#
-# get all callsigns in the database
-#
-
-sub get_all_calls
-{
- return (sort keys %u);
-}
-
-
-#
-# create a string from a user reference
-#
-sub encode
-{
- my $self = shift;
- my $out;
- my $f;
-
- $out = "bless( { ";
- for $f (sort keys %$self) {
- my $val = $$self{$f};
- if (ref $val) { # it's an array (we think)
- $out .= "'$f'=>[ ";
- foreach (@$val) {
- my $s = $_;
- $out .= "'$s',";
- }
- $out .= " ],";
- } else {
- $val =~ s/'/\\'/og;
- $val =~ s/\@/\\@/og;
- $out .= "'$f'=>'$val',";
- }
- }
- $out .= " }, 'DXUser')";
- return $out;
-}
-
# root of directory tree for this system
$root = "/spider";
$root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
-
+
+ mkdir "$root/local_data", 02777 unless -d "$root/local_data";
+
unshift @INC, "$root/perl"; # this IS the right way round!
unshift @INC, "$root/local";
}
-use DXVars;
+use SysVar;
+
use Data::Dumper;
+use DXUtil;
+
use strict;
my %loc = (); # the location unique hash
my %pre = (); # the prefix hash
my %pren = (); # the inverse
+if (@ARGV && $ARVG[0] =~ /^--system$/) {
+ $prefix = $main::data;
+ shift;
+} else {
+ $prefix = $main:local_data;
+}
+
# open the input file
my $ifn = $ARGV[0] if $ARGV[0];
-$ifn = "$main::data/wpxloc.raw" if !$ifn;
+
+$ifn = "$prefix/wpxloc.raw" if !$ifn;
open (IN, $ifn) or die "can't open $ifn ($!)";
# first pass, find all the 'master' location records
my @f;
my @a;
$line = 0;
-if (open(IN, "$main::data/cty.dat")) {
+if (open(IN, "$prefix/cty.dat")) {
my $state = 0;
while (<IN>) {
$line++;
close IN;
-open(OUT, ">$main::data/prefix_data.pl") or die "Can't open $main::data/prefix_data.pl ($!)";
+open(OUT, ">$prefix/prefix_data.pl") or die "Can't open $prefix/prefix_data.pl ($!)";
print OUT "\%pre = (\n";
foreach my $k (sort keys %pre) {
use strict;
use IO::File;
-use DXVars;
+use SysVar;
use DXUtil;
use Spot;
use QSL;
$main::systime = time;
-unlink "$root/data/qsl.v1";
+unlink "$data/qsl.v1";
+unlink "$local_data/qsl.v1";
QSL::init(1) or die "cannot open QSL file";
-my $base = "$root/data/spots";
+my $base = localdata("spots");
opendir YEAR, $base or die "$base $!";
foreach my $year (sort readdir YEAR) {
unshift @INC, "$root/local";
}
-use DXVars;
+use SysVar;
use DXUser;
+use DXUtil;
sub delete_it
{
- DXUser->del_file($userfn);
+ DXUser::del_file();
}
sub create_it
die "\$myalias \& \$mycall are the same ($mycall)!, they must be different (hint: make \$mycall = '${mycall}-2';).\n" if $mycall eq $myalias;
-$lockfn = "$root/local/cluster.lck"; # lock file name
+$lockfn = localdata("cluster.lck"); # lock file name
if (-e $lockfn) {
open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
my $pid = <CLLOCK>;
$ans = <STDIN>;
if ($ans =~ /^[Yy]/) {
delete_it();
- DXUser->init($userfn, 1);
+ DXUser::init(1);
create_it();
} else {
print "Do you wish to reset your cluster and sysop information? [y/N]: ";
$ans = <STDIN>;
if ($ans =~ /^[Yy]/) {
- DXUser->init($userfn, 1);
+ DXUser::init(1);
create_it();
}
}
} else {
- DXUser->init($userfn, 1);
+ DXUser::init(1);
create_it();
}
-DXUser->finish();
+DXUser::finish();
exit(0);
$root = "/spider";
$root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+ mkdir "$root/local_data", 02777 unless -d "$root/local_data";
+
unshift @INC, "$root/perl"; # this IS the right way round!
unshift @INC, "$root/local";
}
-use DXVars;
+use SysVar;
+
use Archive::Zip qw(:ERROR_CODES);
use Archive::Zip::MemberRead;
use IO::File;
STDOUT->autoflush(1);
-my $dbrawfn = "$main::data/usdbraw.gz";
+my $dbrawfn = localdata("usdbraw.gz");
rename "$dbrawfn.oo", "$dbrawfn.ooo";
rename "$dbrawfn.o", "$dbrawfn.oo";
{
my ($zip, $argv) = @_;
my $mname = "EN.dat";
- my $ofn = "$main::data/$mname";
+ my $ofn = localdata($mname);
print " Handling EN records, unzipping";
if ($zip->extractMember($mname, $ofn) == AZ_OK) {
my $fh = new IO::File "$ofn" or die "Cannot open $ofn $!";
unshift @INC, "$root/local";
}
-use DXVars;
+use SysVar;
use DXUtil;
use DXLog;
use Julian;
use strict;
use IO::File;
-use DXVars;
+use SysVar;
use Carp;
my $lang = 'en';
#!/usr/bin/env perl
#
-# remove all records with the sysop/cluster callsign and recreate
-# it from the information contained in DXVars
+# Lock all non local nodes that have a privileges <= 1
#
# WARNING - this must be run when the cluster.pl is down!
#
-# This WILL NOT delete an old sysop call if you are simply
-# changing the callsign.
-#
# Copyright (c) 1998 Dirk Koopman G1TLH
#
#
unshift @INC, "$root/local";
}
-use DXVars;
+use SysVar;
use DXUser;
+use DXUtil;
-my $lockfn = "$root/local/cluster.lck"; # lock file name
+my $lockfn = localdata("cluster.lck"); # lock file name
if (-e $lockfn) {
open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
my $pid = <CLLOCK>;
my @nodes = map { uc } @ARGV;
-DXUser->init($userfn, 1);
+DXUser::init(1);
my $count;
my $nodes;
print "a set/node (set/spider, set/clx etc) on each of them to allow them\n";
print "to connect to you or you to them\n";
-DXUser->finish();
+DXUser::finish();
exit(0);
unshift @INC, "$root/local";
}
-use DXVars;
+use SysVar;
use CmdAlias;
use Carp;
unshift @INC, "$root/local";
}
-use DXVars;
+use SysVar;
use DXUser;
+use DXUtil;
sub create_it
{
die "\$myalias \& \$mycall are the same ($mycall)!, they must be different (hint: make \$mycall = '${mycall}-2';).\n" if $mycall eq $myalias;
-$lockfn = "$root/local/cluster.lck"; # lock file name
+$lockfn = localdata("cluster.lck"); # lock file name
if (-e $lockfn) {
open(CLLOCK, "$lockfn") or die "Can't open Lockfile ($lockfn) $!";
my $pid = <CLLOCK>;
close CLLOCK;
}
-DXUser->init($userfn, 1);
+DXUser::init(1);
create_it();
-DXUser->finish();
+DXUser:finish();
print "Update of $myalias on cluster $mycall successful\n";
exit(0);
}
use IO::File;
-use DXVars;
+use SysVar;
use DXUtil;
use DXLog;
use IO::Socket;
use DXVars;
+use SysVar;
+
use IO::File;
use Config;
projects / spider.git / commitdiff