X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FThingy.pm;h=c1f010c11e3a7c2790759a87acac08187e83fc6e;hb=2f4dc5347389ce78ae58567c0c23d09342c65fcd;hp=c91edc0ce3d0d1d1429d7365338988884f796f94;hpb=dcbafa96df9fbad90df86076b6ee9fa6a673a61c;p=spider.git diff --git a/perl/Thingy.pm b/perl/Thingy.pm index c91edc0c..c1f010c1 100644 --- a/perl/Thingy.pm +++ b/perl/Thingy.pm @@ -16,10 +16,8 @@ use strict; package Thingy; use vars qw($VERSION $BRANCH @queue @permin @persec); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /^\d+\.\d+(?:\.(\d+)\.(\d+))?$/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; + +main::mkver($VERSION = q$Revision$); @queue = (); # the input / processing queue @@ -44,6 +42,8 @@ sub new { my $class = shift; my $thing = {@_}; + + $thing->{origin} ||= $main::mycall; bless $thing, $class; return $thing; @@ -55,27 +55,44 @@ sub send my $thing = shift; my $dxchan = shift; my $class; + my $sub; + if (@_) { $class = shift; } elsif ($dxchan->isa('DXChannel')) { $class = ref $dxchan; } + # BEWARE!!!!! + no strict 'refs'; + # do output filtering if ($thing->can('out_filter')) { return unless $thing->out_filter($dxchan); } - # generate the line which may (or not) be cached - my @out; - if (my $ref = $thing->{class}) { - push @out, ref $ref ? @$ref : $ref; + # before send (and line generation) things + # function must return true to make the send happen + $sub = "before_send_$class"; + if ($thing->can($sub)) { + return $thing->$sub($dxchan); + } + + # generate the protocol line which may (or not) be cached + my $ref; + unless ($ref = $thing->{class}) { + $sub = "gen_$class"; + $ref = $thing->$sub($dxchan) if $thing->can($sub); + } + $dxchan->send(ref $ref ? @$ref : $ref) if $ref; + + # after send + if ($thing->can('after_send_all')) { + $thing->after_send_all($dxchan); } else { - no strict 'refs'; - my $sub = "gen_$class"; - push @out, $thing->$sub($dxchan) if $thing->can($sub); + $sub = "after_send_$class"; + $thing->$sub($dxchan) if $thing->can($sub); } - $dxchan->send(@out) if @out; } # broadcast to all except @_ @@ -87,6 +104,10 @@ sub broadcast foreach my $dxchan (DXChannel::get_all()) { next if $dxchan == $main::me; next if grep $dxchan == $_, @_; + next if $dxchan->{call} eq $thing->{origin}; + next if $thing->{user} && !$dxchan->is_user && $dxchan->{call} eq $thing->{user}; + + dbg("Thingy::broadcast: sending to $dxchan->{call}") if isdbg('thing'); $thing->send($dxchan); } } @@ -100,14 +121,24 @@ sub queue push @queue, $thing; } +# # this is the main commutator loop. In due course it will -# become the *only* commutator loop +# become the *only* commutator loop, This can be called in one +# of two ways: either with 2 args or with none. +# +# The two arg form is an immediate "queue and handle" and does +# a full cycle, immediately +# sub process { my $thing; + if (@_ == 2) { + $thing = shift; + $thing->queue(shift); + } while (@queue) { $thing = shift @queue; - my $dxchan = DXChannel->get($thing->{dxchan}); + my $dxchan = DXChannel::get($thing->{dxchan}); if ($dxchan) { if ($thing->can('in_filter')) { next unless $thing->in_filter($dxchan); @@ -165,5 +196,14 @@ sub ascii $dd->Quotekeys($] < 5.005 ? 1 : 0); return $dd->Dumpxs; } + +sub add_auth +{ + my $thing = shift; + my $s = $thing->{'s'} = sprintf "%X", int(rand() * 100000000); + my $auth = Verify->new("DXSp,$main::mycall,$s,$main::version,$main::build"); + $thing->{auth} = $auth->challenge($main::me->user->passphrase); +} + 1;