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;
  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