]> dxcluster.net Git - spider.git/blob - perl/BBS.pm
fix divide by zero error
[spider.git] / perl / BBS.pm
1 #!/usr/bin/perl
2 #
3 # Sigh, I suppose it had to happen at some point...
4 #
5 # This is a simple BBS Forwarding module.
6 #
7 # Copyright (c) 1999 - Dirk Koopman G1TLH
8 #
9 # $Id$
10 #
11
12 package BBS;
13
14 use strict;
15 use DXUser;
16 use DXChannel;
17 use DB_File;
18 use DXDebug;
19 use vars qw (@ISA %bid $bidfn $lastbidclean $bidcleanint %hash $maxbidage);
20
21 @ISA = qw(DXChannel);
22
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
28
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;
34
35 sub init
36 {
37         tie %hash, 'DB_File', $bidfn;
38 }
39
40 #
41 # obtain a new connection this is derived from dxchannel
42 #
43
44 sub new 
45 {
46         my $self = DXChannel::alloc(@_);
47         return $self;
48 }
49
50 #
51 # start a new connection
52 #
53 sub start
54 {
55         my ($self, $line, $sort) = @_;
56         my $call = $self->{call};
57         my $user = $self->{user};
58         
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
66         
67         # set unbuffered and no echo
68         $self->send_now('B',"0");
69         $self->send_now('E',"0");
70         
71         # send initialisation string
72     $self->send("[SDX-$main::version-H\$]");
73         $self->prompt;
74         $self->state('prompt');
75
76         Log('BBS', "$call", "connected");
77 }
78
79 #
80 # send a prompt
81 #
82
83 sub prompt
84 {
85         my $self = shift;
86         $self->send("$main::mycall>");
87 }
88
89 #
90 # normal processing
91 #
92
93 sub normal
94 {
95         my ($self, $line) = @_;
96
97     my ($com, $rest) = split /\s+/, $line, 2;
98         $com = uc $com;
99         if ($com =~ /^S/) {
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;
104                 unless ($to) {
105                         $self->send('N - no "to" address');
106                         return;
107                 }
108                 unless ($from) {
109                         $self->send('N - no "from" address');
110                         return;
111                 }
112
113                 # now handle the different types of send
114                 if ($com eq 'SB') {
115                         if ($to =~ /^ALL/) {
116                                 $self->send('N - "ALL" not allowed');
117                                 return;
118                         }
119                 } else {
120                 }
121     } elsif ($com =~ /^F/) {
122                 $self->disconnect;
123         } elsif ($com =~ /^(B|Q)/) {
124                 $self->disconnect;
125         }
126 }
127
128 #
129 # end a connection (called by disconnect)
130 #
131 sub disconnect
132 {
133         my $self = shift;
134         my $call = $self->call;
135         Log('BBS', "$call", "disconnected");
136         $self->SUPER::disconnect;
137 }
138
139
140 # process (periodic processing)
141 #
142
143 sub process
144 {
145
146 }
147
148 1;
149