X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fcluster.pl;h=79bca2649becc379f9977628e6ad23443c9e6e71;hb=b953903f1c33ae35ce24bad344e46ab17b0b5d95;hp=20726684de2c7bbbd8f77d583dbe654a41e6d470;hpb=aad4e36d3753bf8dde671d14d73b1d9785b9ff41;p=spider.git

diff --git a/perl/cluster.pl b/perl/cluster.pl
index 20726684..79bca264 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -68,7 +68,6 @@ use DXCommandmode;
 use DXProtVars;
 use DXProtout;
 use DXProt;
-use QXProt;
 use DXMsg;
 use DXCron;
 use DXConnect;
@@ -99,9 +98,10 @@ use Mrtg;
 use USDB;
 use UDPMsg;
 use QSL;
-use Thingy;
 use RouteDB;
-use AMsg;
+use DXXml;
+use DXSql;
+use IsoTime;
 
 use Data::Dumper;
 use IO::File;
@@ -116,12 +116,12 @@ use strict;
 use vars qw(@inqueue $systime $version $starttime $lockfn @outstanding_connects 
 			$zombies $root @listeners $lang $myalias @debug $userfn $clusteraddr 
 			$clusterport $mycall $decease $is_win $routeroot $me $reqreg $bumpexisting
-			$allowdxby
+			$allowdxby $dbh $dsn $dbuser $dbpass $do_xml $systime_days $systime_daystart
 		   );
 
 @inqueue = ();					# the main input queue, an array of hashes
 $systime = 0;					# the time now (in seconds)
-$version = "1.51";				# the version no of the software
+$version = "1.53";				# the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
 #@outstanding_connects = ();     # list of outstanding connects
 @listeners = ();				# list of listeners
@@ -133,9 +133,10 @@ $allowdxby = 0;					# 1 = allow "dx by <othercall>", 0 - don't allow it
 use vars qw($VERSION $BRANCH $build $branch);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
-$main::build += 1;				# add an offset to make it bigger than last system
 $main::build += $VERSION;
 $main::branch += $BRANCH;
+$main::build -= 3;				# fudge (put back for now)
+
 
       
 # send a message to call on conn and disconnect
@@ -172,7 +173,7 @@ sub new_channel
 	# set up the basic channel info
 	# is there one already connected to me - locally? 
 	my $user = DXUser->get_current($call);
-	my $dxchan = DXChannel->get($call);
+	my $dxchan = DXChannel::get($call);
 	if ($dxchan) {
 		if ($user && $user->is_node) {
 			already_conn($conn, $call, DXM::msg($lang, 'concluster', $call, $main::mycall));
@@ -181,8 +182,7 @@ sub new_channel
 		if ($bumpexisting) {
 			my $ip = $conn->{peerhost} || 'unknown';
 			$dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip));
-			Log('DXCommand', "$call bumped off by $ip, disconnected");
-			dbg("$call bumped off by $ip, disconnected");
+			LogDbg('DXCommand', "$call bumped off by $ip, disconnected");
 			$dxchan->disconnect;
 		} else {
 			already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall));
@@ -198,7 +198,7 @@ sub new_channel
 	if ($baseuser && $baseuser->lockout || $lock) {
 		if (!$user || !defined $lock || $lock) {
 			my $host = $conn->{peerhost} || "unknown";
-			Log('DXCommand', "$call on $host is locked out, disconnected");
+			LogDbg('DXCommand', "$call on $host is locked out, disconnected");
 			$conn->disconnect;
 			return;
 		}
@@ -226,29 +226,10 @@ sub new_channel
 
 	# set callbacks
 	$conn->set_error(sub {error_handler($dxchan)});
-	$conn->set_rproc(sub {my ($conn,$msg) = @_; rec($dxchan, $conn, $msg);});
-	rec($dxchan, $conn, $msg);
+	$conn->set_rproc(sub {my ($conn,$msg) = @_; $dxchan->rec($msg);});
+	$dxchan->rec($msg);
 }
 
-sub rec	
-{
-	my ($dxchan, $conn, $msg) = @_;
-	
-	# queue the message and the channel object for later processing
-	if (defined $msg) {
-		my $self = bless {}, "inqueue";
-		$self->{dxchan} = $dxchan;
-		$self->{data} = $msg;
-		push @inqueue, $self;
-	}
-}
-
-# remove any outstanding entries on the inqueue after a disconnection (usually)
-sub clean_inqueue
-{
-	my $dxchan = shift;
-	@inqueue = grep {$_->{dxchan} != $dxchan} @inqueue;
-}
 
 sub login
 {
@@ -273,13 +254,13 @@ sub cease
 	dbg("Local::finish error $@") if $@;
 
 	# disconnect nodes
-	foreach $dxchan (DXChannel->get_all_nodes) {
+	foreach $dxchan (DXChannel::get_all_nodes) {
 	    $dxchan->disconnect(2) unless $dxchan == $main::me;
 	}
 	Msg->event_loop(100, 0.01);
 
 	# disconnect users
-	foreach $dxchan (DXChannel->get_all_users) {
+	foreach $dxchan (DXChannel::get_all_users) {
 		$dxchan->disconnect;
 	}
 
@@ -302,10 +283,12 @@ sub cease
 		$l->close_server;
 	}
 
-	dbg("DXSpider version $version, build $build ended") if isdbg('chan');
-	Log('cluster', "DXSpider V$version, build $build ended");
+	LogDbg('cluster', "DXSpider V$version, build $build ended");
 	dbgclose();
 	Logclose();
+
+	$dbh->finish if $dbh;
+	
 	unlink $lockfn;
 #	$SIG{__WARN__} = $SIG{__DIE__} =  sub {my $a = shift; cluck($a); };
 	exit(0);
@@ -325,45 +308,6 @@ sub reap
 
 # this is where the input queue is dealt with and things are dispatched off to other parts of
 # the cluster
-sub process_inqueue
-{
-	while (@inqueue) {
-		my $self = shift @inqueue;
-		return if !$self;
-
-		my $data = $self->{data};
-		my $dxchan = $self->{dxchan};
-		my $error;
-		my ($sort, $call, $line) = DXChannel::decode_input($dxchan, $data);
-		return unless defined $sort;
-	
-		# do the really sexy console interface bit! (Who is going to do the TK interface then?)
-		dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan');
-		if ($self->{disconnecting}) {
-			dbg('In disconnection, ignored');
-			next;
-		}
-		
-		# handle A records
-		my $user = $dxchan->user;
-		if ($sort eq 'A' || $sort eq 'O') {
-			$dxchan->start($line, $sort);  
-		} elsif ($sort eq 'I') {
-			die "\$user not defined for $call" if !defined $user;
-
-			# normal input
-			$dxchan->normal($line);
-		} elsif ($sort eq 'Z') {
-			$dxchan->disconnect;
-		} elsif ($sort eq 'D') {
-			;					# ignored (an echo)
-		} elsif ($sort eq 'G') {
-			$dxchan->enhanced($line);
-		} else {
-			print STDERR atime, " Unknown command letter ($sort) received from $call\n";
-		}
-	}
-}
 
 sub uptime
 {
@@ -388,8 +332,14 @@ sub AGWrestart
 #############################################################
 
 $starttime = $systime = time;
+$systime_days = int ($systime / 86400);
+$systime_daystart = $systime_days * 86400; 
 $lang = 'en' unless $lang;
 
+unless ($DB::VERSION) {
+	$SIG{INT} = $SIG{TERM} = \&cease;
+}
+
 # open the debug file, set various FHs to be unbuffered
 dbginit(\&DXCommandmode::broadcast_debug);
 foreach (@debug) {
@@ -401,11 +351,20 @@ STDOUT->autoflush(1);
 $build += $main::version;
 $build = "$build.$branch" if $branch;
 
-Log('cluster', "DXSpider V$version, build $build started");
+# try to load the database
+if (DXSql::init($dsn)) {
+	$dbh = DXSql->new($dsn);
+	$dbh = $dbh->connect($dsn, $dbuser, $dbpass) if $dbh;
+}
+
+# try to load XML::Simple
+DXXml::init();
 
 # banner
-dbg("Copyright (c) 1998-2002 Dirk Koopman G1TLH");
-dbg("DXSpider Version $version, build $build started");
+my ($year) = (gmtime)[5];
+$year += 1900;
+LogDbg('cluster', "DXSpider V$version, build $build started");
+dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH");
 
 # load Prefixes
 dbg("loading prefixes ...");
@@ -438,10 +397,12 @@ dbg("Internal port: $clusteraddr $clusterport using IntMsg");
 foreach my $l (@main::listen) {
 	no strict 'refs';
 	my $pkg = $l->[2] || 'ExtMsg';
-	$conn = $pkg->new_server($l->[0], $l->[1], \&login);
-	$conn->conns("Server $l->[0]/$l->[1] using $pkg");
+	my $login = $l->[3] || 'login'; 
+	
+	$conn = $pkg->new_server($l->[0], $l->[1], \&{"${pkg}::${login}"});
+	$conn->conns("Server $l->[0]/$l->[1] using ${pkg}::${login}");
 	push @listeners, $conn;
-	dbg("External Port: $l->[0] $l->[1] using $pkg");
+	dbg("External Port: $l->[0] $l->[1] using ${pkg}::${login}");
 }
 
 dbg("AGW Listener") if $AGWMsg::enable;
@@ -501,7 +462,6 @@ Spot->init();
 # initialise the protocol engine
 dbg("Start Protocol Engines ...");
 DXProt->init();
-QXProt->init();
 
 # put in a DXCluster node for us here so we can add users and take them away
 $routeroot = Route::Node->new($mycall, $version*100+5300, Route::here($main::me->here)|Route::conf($main::me->conf));
@@ -545,17 +505,25 @@ for (;;) {
 	
 	Msg->event_loop(10, 0.010);
 	my $timenow = time;
-	process_inqueue();			# read in lines from the input queue and despatch them
+
+	DXChannel::process();
+	
 #	$DB::trace = 0;
 	
 	# do timed stuff, ongoing processing happens one a second
 	if ($timenow != $systime) {
-		reap if $zombies;
+		reap() if $zombies;
 		$systime = $timenow;
+		my $days = int ($systime / 86400);
+		if ($systime_days != $days) {
+			$systime_days = $days;
+			$systime_daystart = $days * 86400;
+		}
+		IsoTime::update($systime);
 		DXCron::process();      # do cron jobs
 		DXCommandmode::process(); # process ongoing command mode stuff
+		DXXml::process();
 		DXProt::process();		# process ongoing ak1a pcxx stuff
-		QXProt::process();
 		DXConnect::process();
 		DXMsg::process();
 		DXDb::process();
@@ -563,9 +531,6 @@ for (;;) {
 		DXDupe::process();
 		AGWMsg::process();
 
-		# this where things really start to happen (in DXSpider 2)
-		Thingy::process();
-		
 		eval { 
 			Local::process();       # do any localised processing
 		};