PROGRAM LServ;

{ this program dumps all records in a listserv.tdb }

USES Tdb,
     Ramon,
     Fido,
     Database,
     UnixTime;

VAR Rec : ListServerRecord;

FUNCTION Access2Str (Access : ListAccessType) : STRING;
BEGIN
     IF (Access = laReadWrite) THEN
     BEGIN
          Access2Str:='ReadWrite';
          Exit;
     END;

     IF (Access = laReadOnly) THEN
     BEGIN
          Access2Str:='Receive only';
          Exit;
     END;

     IF (Access = laWriteOnly) THEN
     BEGIN
          Access2Str:='Post only';
          Exit;
     END;

     Access2Str:='Invalid: '+Byte2String (Byte (Access))+' ** ERROR **';
END;

PROCEDURE PrintRec;
BEGIN
     WITH Rec DO
     BEGIN
          IF Deleted THEN
             WriteLn (Output,'   **DELETED**');

          IF (ListSystem = lstName) THEN
          BEGIN
               WriteLn (Output,'   Mailing list definition');
               WriteLn (Output,'   Name: ',ListName);
               WriteLn (Output,'   Description: ',ListDescription);
               WriteLn (Output,'   Welcome file: ',ListWelcome);
               WriteLn (Output,'   List AKA: ',ListAKA);
               WriteLn (Output,'   Private: ',ListPrivate);
               WriteLn (Output,'   Only known: ',OnlyKnown);
               WriteLn (Output,'   Active: ',Active);
               WriteLn (Output,'   AreaName: ',AreaName);
               WriteLn (Output,'   AreaToList: ',EchoList);
               WriteLn (Output,'   ListToArea: ',ListEcho);
               WriteLn (Output,'   DefaultAccess: ',Access2Str (DefaultAccess));
               WriteLn (Output,'   Priority: ',Byte (MLAddress));
               WriteLn (Output,'   Confirm interval: ',ConfirmInterval);
               WriteLn (Output,'   Home domain: ',HomeDomain);
               WriteLn (Output,'   AdminPassword: ',AdminPassword);
               WriteLn (Output,'   First user: ',NextUser);
               Exit;
          END;

          CASE ListSystem OF
               lstFTN:
                   WriteLn (Output,'   Subscriber type: FTN');

               lstRFC:
                   WriteLn (Output,'   Subscriber type: RFC');

               lstRemoteGW:
                   WriteLn (Output,'   Subscriber type: Remote GW');

               ELSE BEGIN
                    WriteLn (Output,'   Invalid subscriber type: ',Byte (ListSystem),' ** ERROR **');
                    Exit;
               END;
          END; { case }

          WriteLn (Output,'   Next user:      ',NextUser);
          WriteLn (Output,'   Access:         ',Access2Str (Access));
          WriteLn (Output,'   SubscribedDate: ',UnixTimeToString (SubscribedDate));
          WriteLn (Output,'   ConfirmedDate:  ',UnixTimeToString (ConfirmedDate));
          WriteLn (Output,'   ConfirmReqDate: ',UnixTimeToString (ConfirmReqDate));
          WriteLn (Output,'   ConfirmState:   ',Byte (ConfirmState));
          WriteLn (Output,'   ConfirmCode:    ',ConfirmCode);

          IF (ListSystem = lstFTN) THEN
          BEGIN
               WriteLn (Output,'   Address:        ',Fido2Str (Address));
               WriteLn (Output,'   Name:           "',Name,'"');
          END;

          IF (ListSystem = lstRFC) THEN
             WriteLn (Output,'   Email:          ',Email);

          IF (ListSystem = lstRemoteGW) THEN
          BEGIN
               WriteLn (Output,'   GWAddress:      ',Fido2Str (GWAddress));
               WriteLn (Output,'   GWUser:         "',GWUser,'"');
               WriteLn (Output,'   GWEmail:        ',GWEmail);
          END;
     END; { with }
END;

VAR TdbNr : TdbNrType;
    Lp    : WORD;

BEGIN
     IF (ParamCount <> 1) THEN
     BEGIN
          WriteLn ('Usage: lserv <path to listserv.tdb>');
          WriteLn ('Example: lserv c:\wtrgate\listserv.tdb');
          Halt;
     END;

     IF (TdbOpen (ParamStr (1),TdbNr) <> _TdbOk) THEN
     BEGIN
          WriteLn ('Error opening '+ParamStr (1)+' (error ',TdbLastIOResult,')');
          Halt;
     END;

     TdbSetIO (TdbNr,SizeOf (ListServerRecord));
     IF (TdbReadHeader (TdbNr) <> ListServerHeader) THEN
     BEGIN
          WriteLn ('Incompatible database format');
          Halt;
     END;

     Assign (Output,'');
     Rewrite (Output);

     FOR Lp:=1 TO TdbRecCount (TdbNr) DO
     BEGIN
          TdbRead (TdbNr,Lp,Rec);

          WriteLn (Output);
          WriteLn (Output,'Rec ',Lp);
          PrintRec;
     END; { for }

     TdbClose (TdbNr);
END.
