Comment
=============================================================

FwdGate Message Forwarding Control Menu
Copyright 1995 by Marc Perkel * All Rights Reserved

=============================================================
EndComment

;#Define Shareware

var
  MailFiles
  GateDir
  Mcb
  ToList
  OldFileName
  AdminAddress
  CopyToAdmin
  Logging
  Log
  RestOfLine
  FileName

var
  Fwd
  Ini
  Defaults
  User
  UserArray
  BoxHeight
  TimeOut

Const
  Version = '1.03'
  RelDate = '11-30-95'


GateMessages
ExitMenu

;=========================================================

Procedure ForwardControl
var FileDir KeyWord TurnOn Change Address P St
var LocalCopy FwdLoggedIn PrefApp

   ;- parse user name

   P = pos('.',UserName)
   if P > 0
      User = Mid(UserName,P+1,255)
   else
      Help
      Return
   endif

   if User = 'DUMMY'
      SubjectIsPassword = True
   endif

   ;- calculate file directory and verify user exists

   FileDir = TrueName(%MV% + 'MHS\MAIL\USERS\' + User)

   if not ExistDir FileDir
      UserNotFound
      Return
   endif

   ;- If they don't have system password, check list.

   if not SubjectIsPassword

      ;- Are they in the list?

      P = PosInListLeft(User + '=',UserArray)
      if P = 0
         UserNotFound
         Return
      else
         St = RightOfEqual(UserArray[P])
         SubjectIsPassword = Subject = St
         if not SubjectIsPassword
            SubjectIsPassword = NovUserPassword(User,Subject)
         endif
      endif

   endif

   ;- Check for Password

   if SubjectIsPassword
      Say 'Password OK'
   else
      Say 'Required Password not Found!'
      NeedsPassword
      Return
   endif

   OldFileName = FileDir + '\FORWARD'

   ;- read the old file if there is one

   if ExistFile (OldFileName + '.SMF')
      OldFileName = OldFileName + '.SMF'
      ReadTextFile(OldFileName,Fwd)

   elseif ExistFile (OldFileName + '.SAV')
      OldFileName = OldFileName + '.SAV'
      ReadTextFile(OldFileName,Fwd)

   endif

   FileName = OldFileName

   ;- Set default settings into array if missing

   SetDefFwd('Forward-to:',ReplyTo)
   Loop Defaults
      SetDefFwd(LoopVal[1],LoopVal[2])
   EndLoop

   ;- parse changes in body of message

   Loop Message
      RestOfLine = LoopVal
      KeyWord = NextWordDelim(RestOfLine,'=:')

      if KeyWord = 'FORWARD'
         TurnOn = ReadBoolean(RestOfLine)
         Change = TurnOn <> (Extension(OldFileName) = 'SMF')

      elseif (KeyWord = 'FORWARD-TO') or (KeyWord = 'ADDRESS')
         Address = RestOfLine
         if Address = 'HERE' then Address = ReplyTo

      elseif KeyWord = 'KEEP-LOCAL-COPY'
         ChangeFwd('Keep-local-copy:',TFString)

      elseif KeyWord = 'FORWARD-PREFERRED-APP-ONLY'
         ChangeFwd('Forward-preferred-app-only:',TFString)

      elseif KeyWord = 'FORWARD-EVEN-WHEN-LOGGED-IN'
         ChangeFwd('Forward-even-when-logged-in:',TFString)

      elseif KeyWord = 'PASSWORD'
         Say 'Changing Password for: ' User
         P = PosInListLeft(User + '=',UserArray)
         UserArray[P] = User + '=' + UpperCase(RestOfLine)
         WriteTextFile('FWDGATE.USR',UserArray)

      endif
   EndLoop

   if Address > ''
      ChangeFwd('Forward-to:',Address)
   endif

   ;- write changes

   if Change and not TimeOut
      Say 'Forwarding: ' TurnOn
      DelFile OldFileName
      if TurnOn
         FileName = FileDir + '\FORWARD.SMF'
      else
         FileName = FileDir + '\FORWARD.SAV'
      endif

      WriteTextFile(FileName,Fwd)
   endif

   ;- Send Status Settings

   Urgent On
   InReplyTo = MessageID
   ReplyHead(ReplyTo,'Settings for: ' + User)

   SendForwardingStatus

   Instructions
   SendReply

   LogRequestMessage
   WriteLog

   FileName = ''
   Dispose Fwd

EndProc


Procedure Help
   ReplyHead(ReplyTo,'Instructions for FwdGate')
   Instructions
   SendReply
EndProc


Procedure Instructions
   Reply ''
   Reply 'User Instructions:'
   Reply '------------------'
   Reply ''
   Reply 'FwdGate: Copyright 1995 by Marc Perkel * All Rights Reserved'
   Reply ''
   Reply 'Address your message to: FWDGATE.<USER> @ <HOST>
   Reply ''
   Reply 'Example: FWDGATE.BUDDY@CTYME
   Reply ''
   Reply 'You will need to put the FwdGate password on the Subject line.'
   Reply 'This can be either your personal FwdGate password or your'
   Reply 'Novell password.'
   Reply ''
   Reply 'Forwarding features are controlled by ading control commands'
   Reply 'in the body of the message you send to FwdGate.'
   Reply ''
   Reply 'To turn forwarding on,  add a line: FORWARD ON'
   Reply 'To turn forwarding off, add a line: FORWARD OFF'
   Reply ''
   Reply 'To set the address to forward your mail to, add a line:'
   Reply 'Forward-to: <ADDRESS>'
   Reply ''
   Reply 'To forward to the address where you are sending mail from, use'
   Reply 'the command: Forward-to: HERE'
   Reply ''
   Reply 'Other settable features include:'
   Reply ''
   Reply 'Keep-local-copy: True/False'
   Reply 'Forward-preferred-app-only: True/False'
   Reply 'Forward-even-when-logged-in: True/False'
   Reply ''
   Reply 'To change your personal FwdGate password, add a line:'
   Reply 'Password: <New Password>'

   if User = 'DUMMY'
      Reply ''
      Reply 'This is a dummy user. Go ahead and play with it. You can forward'
      Reply 'mail to yourself and then send mail to DUMMY @ CTYME and it'
      Reply "should come back to you. Dummy doesn't require a password."
      Reply ''
      Reply 'For info call 417-866-1222 and ask for Marc.'
   endif
EndProc


Procedure SetDefFwd (Key,Param)
var P

   ;- add if Key not found

   P = PosInListLeft(Key,Fwd)
   if P > 0 then Return
   AppendArray(Fwd,Key + ' ' + Param)
   Say Key + ' ' + Param
EndProc


Procedure ChangeFwd (Key,Param)
var P

   ;- Change if Key is found

   P = PosInListLeft(Key,Fwd)
   if P = 0 then Return
   Fwd[P] = Key + ' ' + Param
   Say Fwd[P]
EndProc


Procedure ReadBoolean (St)
   if St = 'ON' then Return True
   if St = 'TRUE' then Return True
   if St = 'Y' then Return True
   if St = 'YES' then Return True
   Return False
EndProc


Procedure TFString
   if ReadBoolean(RestOfLine) then Return 'TRUE' else Return 'FALSE'
EndProc


Procedure UserNotFound

   ;- error if user not found

   Say 'Error: User not Found!'
   LogRequestMessage
   ReplyHead(ReplyTo,'User Not Found!')
   ReplyLog ''
   ReplyLog 'Error: User ' User ' does not exist on this system or'
   ReplyLog 'is not authorized for remote forwarding control.'
   Instructions
   SendReply
   WriteLog
EndProc


Procedure NeedsPassword

   ;- error if user needs password

   LogRequestMessage
   ReplyHead(ReplyTo,'Password Required!')
   ReplyLog ''
   ReplyLog 'This system requires a valid password on the Subject field.'
   ReplyLog ''
   ReplyLog 'Subject: ' Subject
   SendReply
   WriteLog
EndProc


Procedure ReplyLog ($St)
   Reply(St)
   LogSt(St)
EndProc


;============================================================

Procedure GateMessages
var Discuss St P MessageName

   Setup

   GateDir = '..\OUT\*.'
   WholeFileNames On
   ReadDirectory(GateDir,MailFiles)

   if NumberOfElements(MailFiles) = 1
      St = 'Message'
   else
      St = 'Messages'
   endif
   Say NumberOfElements(MailFiles) ' ' St

   Loop MailFiles
      MhsReadFile(LoopVal,Message,Header)

      Mcb = HeaderLine(Header,'200MCB-OPTIONS:')
      Receipt = (Mid(Mcb,2,1) = 'Y') or (Mid(Mcb,6,1) = 'Y')
      NonDelNotify = (Mid(Mcb,3,1) = 'Y') or (Mid(Mcb,8,1) = 'Y')
      Urgent = Mid(Mcb,4,1) = 'U'
      MessageID = HeaderLine(Header,'MESSAGE-ID:')

      dispose(ToList)
      P = PosInListPartial('SEND-TO:',Header)
      repeat
         St = Header[P]
         AppendToList(St)
         P = P + 1
      until Header[P] contains ':'

      From = HeaderLine(Header,'SENDER');
      ReplyTo = HeaderLine(Header,'REPLY-TO');
      if ReplyTo = '' then ReplyTo = From
      P = PosInListPartial('SUBJECT:',Header)
      if P > 0
         Subject = Header[P]
         Subject = Chop(Subject)

         while Subject StartsWith 'RE:'
            delete(Subject,1,3)
            Trim(Subject)
         endwhile

         while Subject StartsWith 'FWD:'
            delete(Subject,1,4)
            Trim(Subject)
         endwhile

         trim(Subject)
      endif

      SubjectIsPassword = (Subject = GatePassword) or (GatePassword = 'NONE')

      Loop ToList
         To = LoopVal

         UserName = UpperCase(left(To,pos('@',To)-1))

         GotoXY 9 4
         Write From
         ClearLine
         GotoXY 9 5
         Write To
         ClearLine

         ForwardControl

         if Receipt
            SendReceipt
         endif
      EndLoop

      InReplyTo = ''
      DelFile LoopVal

   EndLoop

EndProc


Procedure SendReceipt
   ReplyHead(From,'RCPT: From MarxGate')
   Reply '22MCB-TYPE: 1'
   Reply 'RET-MESSAGE: ' MessageID
   Reply ''
   SendReply
EndProc


Procedure HeaderLine (Header,Line)
var P
   P = PosInListPartial(Line,Header)
   if P = 0 then Return ''
   Return Chop(Header[P])
EndProc


Procedure Chop (St)
   trim(St)
   delete(St,1,pos(' ',St))
   trim(St)
   Return St
EndProc


Procedure AppendToList (St)
var P St2
   repeat

      if St contains ':'
         St = Chop(St)
      endif

      P = pos(',',St)
      if P > 0
         St2 = Left(St,P-1)
         delete(St,1,P)
      else
         St2 = St
      endif
      Trim(St2)
      if St2 > '' then AppendArray(ToList,St2)
   until P = 0
EndProc


;Common code used by all MarxGate modules


Shared
  GatePassword
  ReplyArray
  Command
  SubjectIsPassword
  RebootOnExit

Shared
  Message
  Header
  To
  ReplyTo
  From
  Subject
  MessageID
  InReplyTo
  UserName
  Receipt
  NonDelNotify
  Urgent


Procedure Reply ($St)
   AppendArray(ReplyArray,St)
EndProc


Procedure ReplyHeader (From,To,Subject)
var St
   Reply 'SMF-70'
   Reply 'FROM: ' From
   Reply 'TO: ' To
   Reply 'SUBJECT: ' Subject

   if InReplyTo > ''
      Reply 'IN-REPLY-TO: ' InReplyTo
   endif

   if Urgent
      St = 'U'
   else
      St = 'N'
   endif

   Reply '200MCB-OPTIONS: NNY' St 'ANAYA'
EndProc


Procedure ReplyHead (To,Subject)
   ReplyHeader('ADMIN@FWDGATE(Forward Control)',To,Subject)
EndProc


Procedure SendReply
   #If Shareware
      Reply ''
      Reply 'FwdGate Evaluation Copy'
      if TimeOut
         Reply ''
         Reply 'This evaluation copy of FwdGate has timed out and is'
         Reply 'no longer functional.'
      endif
   #Endif

   Say 'Sending Message To: ' Mid(ReplyArray[3],5,255)

   WriteTextFile('..\IN\' + UniqueFileName,ReplyArray)
   dispose ReplyArray
EndProc


Procedure LogSt ($St)
   AppendArray(Log,St)
EndProc


Procedure LogRequestMessage
   LogSt ''
   LogSt ''
   LogSt 'Forward Change Request on: ' DateString ' ' TimeString
   LogSt ''
   LogSt '==> From: ' From
   LogSt '==>   To: ' To
   if NumberOfElements(Message) > 0
      LogSt ''
      LogSt 'Message:'
      LogSt '--------'
      Loop Message
         LogSt LoopVal
      EndLoop
   endif
EndProc


Procedure WriteLog
var Handle
   LogSt ''
   LogSt '==========================================================='
   if Logging
      FileAssign(Handle,'FWDGATE.LOG')
      FileAppend(Handle)
      Loop Log
         FileLog(Handle,LoopVal)
      EndLoop
      FileClose(Handle)
   endif

   if CopyToAdmin then SendCopyToAdmin

   dispose(Log)
EndProc


Procedure SendCopyToAdmin
   ReplyHeader(From,AdminAddress,'FwdGate Accessed')
   Loop Log
      Reply LoopVal
   EndLoop
   SendForwardingStatus
   SendReply
EndProc


Procedure SendForwardingStatus
   Reply ''
   Reply 'Current Forwarding Settings:'
   Reply '----------------------------'
   Reply ''
   Reply 'User: ' User
   if Extension(FileName) = 'SMF'
      Reply 'Forward: TRUE'
   else
      Reply 'Forward: FALSE'
   endif

   Loop Fwd
      Reply LoopVal
   EndLoop
   Reply ''
   Reply '----------------------------'
EndProc


Procedure Say ($St)
   GotoXY 9 BoxHeight - 2
   Write St
   ClearLine
   Wait 50
EndProc


Procedure Setup
var S E A St

   #If Shareware
      TimeOut = Now > (TimeOf(RelDate) + 15000000)
   #Endif

   SinglelineBox

   if ColorScreen
      BoxInsideColor LCyan Blue
      BoxBorderColor Yellow Blue
      BoxHeaderColor Yellow Mag
   else
      BoxInsideColor Grey Black
      BoxBorderColor White Black
      BoxHeaderColor Black Grey
   endif

   #If Shareware
      BoxFooterRight ' Evaluation Version * Please Register '
   #Else
      BoxFooterRight ' Registered Version '
   #Endif

   Explode Off
   BoxHeight = 9
   Drawbox 1 8 80 BoxHeight

   St = 'ForwardGate - Version ' + Version + ' * Release Date: ' + RelDate
   WriteCenter St
   Writeln
   WriteCenter 'Copyright 1995 by Marc Perkel * All Rights Reserved'
   Writeln

   TextColor LGreen Blue
   ClearLine 196
   Writeln
   GotoXY 1 BoxHeight - 3
   ClearLine 196

   if ColorScreen
      TextColor White Blue
   else
      TextColor Grey Black
   endif

   GotoXY 1 4
   Writeln '  From:'
   Write   '    To:'
   GotoXY 1 BoxHeight - 2
   Write   ' Event:'

   if ColorScreen
      TextColor Yellow Blue
   else
      TextColor White Black
   endif

   AmPm
   UpperCaseCompare On

   ;- Read Defaults

   if ExistFile 'FWDGATE.INI'
      ReadTextFile('FWDGATE.INI',Ini)
   else
      Install
   endif

   S = PosInList('[Control]',Ini) + 1
   while not (Ini[S] StartsWith '[') and (S <= NumberOfElements(Ini))
      if Ini[S] StartsWith 'PASSWORD='
         GatePassword = RightOfEqual(Ini[S])

      elseif Ini[S] StartsWith 'LOGGING='
         Logging = ReadBoolean(RightOfEqual(Ini[S]))

      elseif Ini[S] StartsWith 'Admin='
         AdminAddress = RightOfEqual(Ini[S])

      elseif Ini[S] StartsWith 'COPYTOADMIN='
         CopyToAdmin = ReadBoolean(RightOfEqual(Ini[S]))

      endif
      S = S + 1
   endwhile

   if AdminAddress = '' Then CopyToAdmin = False
   if GatePassword = '' then GatePassword = 'NONE'

   S = PosInList('[Defaults]',Ini)
   Loop S + 1 NumberOfElements(Ini) Ini
      if LoopVal StartsWith '[' then Return
      A[1] = LeftOfEqual(LoopVal)
      Length(A[1]) = Length(A[1]) - 1
      A[1] = A[1] + ':'
      A[2] = RightOfEqual(LoopVal)
      AppendArray(Defaults,A)
   EndLoop

   FwdGateUsers

EndProc


;=========================[ Installation Section ]========================

var
  InstallArray
  MhsUserArray
  MhsUser
  C2Password


Procedure GetLine (St)
var S
   GotoXY 9 BoxHeight - 2
   Write St ' '
   InputBlankChar '_'
   InputLength 40
   UpperCaseOnly
   S = Readln
   if LastKey = Esc then ExitMenu
   Return S
EndProc


Procedure FindMhsUser
var St
   if MhsUser > '' then Return
   MhsUser = ExistOnPath 'MHSUSER.EXE'
   if MhsUser = ''
      St = '\MHS\EXE\MHSUSER.EXE'
      if ExistFile St
         MhsUser = St
      endif
   endif
   if MhsUser = ''
      AbortInstall 'Can not access MHSUSER.EXE'
   endif
EndProc


Procedure ExecMhsUser (Command)
var St
   FindMhsUser
   ClearScreenFirst Off
   repeat
      if C2Password > ''
         St = ' -S' + C2Password + ' '
      else
         St = ' '
      endif
      UseCommand Off
      Execute MhsUser + St + Command
      if ReturnCode > 0
         C2Password = GetLine('Enter MHS or Connect2 Password:')
      endif
   until ReturnCode <> 1
EndProc


Procedure RunMhsUser (Command)
   ExecMhsUser(Command + ' > MHSUSER.$$$')
   ReadTextFile('MHSUSER.$$$',MhsUserArray)
   DelFile 'MHSUSER.$$$'
EndProc


Procedure AddUsrLine ($St)
   AppendArray(UserArray,St)
EndProc


Procedure FwdGateUsers
var St
   ;- Get list of all MHS users.

   if ExistFile 'FWDGATE.USR'
      ReadTextFile('FWDGATE.USR',UserArray)
   else
      Say 'Creating FWDGATE.USR'
      AddUsrLine '; FwdGate User List'
      AddUsrLine '; These users are allowed to use remote forwarding.'
      AddUsrLine '; The right side of the = is the users password.'
      AddUsrLine '; You can remove users from this list that you do'
      AddUsrLine '; not want to be able to use FwdGate.'
      AddUsrLine ''
      AddUsrLine '; USER=PASSWORD'
      AddUsrLine ''
      RunMhsUser '-X03'
      SortArray(MhsUserArray)
      Loop MhsUserArray
         St = Left(LoopVal,8)
         Trim(St)
         if (St > '') and not (St StartsWith '-')
            AddUsrLine St '=' GatePassword
         endif
      EndLoop
      WriteTextFile('FWDGATE.USR',UserArray)
   endif
EndProc


Procedure Line ($St)
   AppendArray(InstallArray,St)
EndProc


Procedure AbortInstall ($St)
   EraseTopWindow
   Writeln
   Writeln 'FwdGate Installation Error'
   Writeln 'Error: ' St
   Writeln
   ExitMenu
EndProc


Procedure Install
var Admin WorkGroup P PublicDir St

   Say 'Installing FwdGate'

   PublicDir = MhsDirectory + '\MAIL\GATES\FWDGATE\PUBLIC'

   if not ExistDir PublicDir

      ;- Create Gateway

      Say 'Creating FwdGate Gateway'
      ExecMhsUser '-X31 -HFWDGATE -EFwdGate Gateway -T4 -C70'

   endif

   if ExistDir PublicDir
      Say 'Copying files to ' PublicDir
      ClearScreenFirst Off
      Execute 'copy fwdgate.* ' PublicDir ' >nul'
      ChDir PublicDir
   else
      AbortInstall 'Failed to Create FwdGate'
   endif

   ;- Create User Route

   Say 'Creating User Route'
   ExecMhsUser '-X41 -UFWDGATE -EFwdGate Gateway -RFWDGATE'

   ;- Create RUNIT.BAT

   if not ExistFile 'RUNIT.BAT'
      Say 'Creating RUNIT.BAT'
      Line '@echo off'
      Line 'if not exist fwdgate.exe goto marx'
      Line 'fwdgate.exe'
      Line 'goto done'
      Line ''
      Line 'Rem FwdGate is written in MarxMenu'
      Line ''
      Line ':marx'
      Line 'marxmenu.exe fwdgate'
      Line ':done'

      WriteTextFile('RUNIT.BAT',InstallArray)
      dispose InstallArray
   endif

   RunMhsUser '-X00'

   P = PosInListLeft('ADMIN:',MhsUserArray)
   if P > 0
      Admin = MhsUserArray[P]
      delete(Admin,1,7)
   endif

   P = PosInListLeft('WORKGROUP:',MhsUserArray)
   if P > 0
      WorkGroup = MhsUserArray[P]
      delete(WorkGroup,1,11)
   endif

   if Admin > ''
      AdminAddress = Admin + '@' + WorkGroup
      Say 'Address of Admin: ' AdminAddress
   else
      AdminAddress = GetLine 'Address of Admin:'
   endif

   GatePassword = GetLine 'Enter a Password for FwdGate to use:'

   ;- Create FWDGATE.INI

   if not ExistFile 'FWDGATE.INI'
      Say 'Creating FWDGATE.INI'
      Line '[Control]'
      Line 'Password=' + GatePassword
      if AdminAddress > ''
         Line 'Admin=' + AdminAddress
         Line 'CopyToAdmin=Y'
      else
         Line 'Admin='
         Line 'CopyToAdmin=N'
      endif
      Line 'Logging=Y'
      Line ''
      Line '[Defaults]'
      Line 'Keep-local-copy=True'
      Line 'Forward-preferred-app-only=False'
      Line 'Forward-even-when-logged-in=True'

      WriteTextFile('FWDGATE.INI',InstallArray)
   endif

   FwdGateUsers

   ReplyHeader(AdminAddress,'FWD @ CTYME','Subscribe')
   Reply ''
   Reply AdminAddress ' just installed a copy of FwdGate.'
   Reply ''
   Reply 'Version ' Version ' * Release Date: ' RelDate
   SendReply

   ReplyHead(AdminAddress,'FwdGate Installed!')
   Reply ''
   Reply 'Thank you for taking the time to install FwdGate. If you'
   Reply 'have any questions, feel free to call 417-866-1222 for'
   Reply 'technical support, or you can email us at the address:'
   Reply 'FWD @ CTYME.'
   Reply ''
   Reply 'To set up special features and customize FwdGate, edit the'
   Reply 'FWDGATE.INI and FWDGATE.USR files.'
   Reply ''
   Reply 'To control who is able to use FwdGate and set individual'
   Reply 'passwords, edit the FWDGATE.USR file.'
   Reply ''
   Reply ''
   Reply 'About Bugs and Features:'
   Reply '------------------------'
   Reply ''
   Reply 'If you find any bugs in this program, I want to know about'
   Reply 'it. If there are any features you would like added, let me'
   Reply 'know. I have found that it is easier to fix bugs than to'
   Reply 'support broken programs.'
   Reply ''
   Reply ''
   Reply 'Support News List:'
   Reply '------------------'
   Reply ''
   Reply 'As part of the installation process, a message is being sent'
   Reply 'to our support news list that will automatically add you as a'
   Reply 'member. You will receive a confirmation message shortly. After'
   Reply 'that, all new messages from the support forum will include you.'
   Reply ''
   Reply ''

   #If Shareware
      Reply 'This is a fully working evaluation copy. If you like it,'
      Reply 'you can buy a registered version by contacting us. The'
      Reply 'price is $95 per Connect2 host. Please remember to'
      Reply "register. I'd sure hate to have to get a real job."
      Reply ''
   #Endif

   Reply 'Current Installation Settings: (FWDGATE.INI)'
   Reply '--------------------------------------------'
   Reply ''
   Loop InstallArray
      Reply LoopVal
   EndLoop

   Reply ''
   Reply 'Users Allowed to Access FwdGate: (FWDGATE.USR)'
   Reply '----------------------------------------------'
   Reply ''
   Loop UserArray
      Reply LoopVal
   EndLoop

   SendReply

   Say 'Installation Successful!'
   ExitMenu
EndProc