3 # Sigh, I suppose it had to happen at some point...
5 # This is a simple BBS Forwarding module.
7 # Copyright (c) 1999 - Dirk Koopman G1TLH
19 use vars qw (@ISA %bid $bidfn $lastbidclean $bidcleanint %hash $maxbidage);
23 %bid = (); # the bid hash
24 $bidfn = "$main::root/msg/bid"; # the bid file filename
25 $lastbidclean = time; # the last time the bid file was cleaned
26 $bidcleanint = 86400; # the time between bid cleaning intervals
27 $maxbidage = 60; # the maximum age of a stored bid
29 use vars qw($VERSION $BRANCH);
30 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
31 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
32 $main::build += $VERSION;
33 $main::branch += $BRANCH;
37 tie %hash, 'DB_File', $bidfn;
41 # obtain a new connection this is derived from dxchannel
46 my $self = DXChannel::alloc(@_);
51 # start a new connection
55 my ($self, $line, $sort) = @_;
56 my $call = $self->{call};
57 my $user = $self->{user};
59 # remember type of connection
60 $self->{consort} = $line;
61 $self->{outbound} = $sort eq 'O';
62 $self->{priv} = $user->priv;
63 $self->{lang} = $user->lang;
64 $self->{isolate} = $user->{isolate};
65 $self->{consort} = $line; # save the connection type
67 # set unbuffered and no echo
68 $self->send_now('B',"0");
69 $self->send_now('E',"0");
71 # send initialisation string
72 $self->send("[SDX-$main::version-H\$]");
74 $self->state('prompt');
76 Log('BBS', "$call", "connected");
86 $self->send("$main::mycall>");
95 my ($self, $line) = @_;
97 my ($com, $rest) = split /\s+/, $line, 2;
100 my ($to, $at, $from) = $rest =~ /^(\w+)\s*\@\s*([\#\w\.]+)\s*<\s*(\w+)/;
101 my ($bid) = $rest =~ /\$(\S+)$/;
102 my ($justat, $haddr) = $at =~ /^(\w+)\.(.*)$/;
103 $justat = $at unless $justat;
105 $self->send('N - no "to" address');
109 $self->send('N - no "from" address');
113 # now handle the different types of send
116 $self->send('N - "ALL" not allowed');
121 } elsif ($com =~ /^F/) {
123 } elsif ($com =~ /^(B|Q)/) {
129 # end a connection (called by disconnect)
134 my $call = $self->call;
135 Log('BBS', "$call", "disconnected");
136 $self->SUPER::disconnect;
140 # process (periodic processing)