(**************************************************************************)
(*                                                                        *)
(*  The Weasel mail server                                                *)
(*  Copyright (C) 2022   Peter Moylan                                     *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 3 of the License, or     *)
(*  (at your option) any later version.                                   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful,       *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU General Public License for more details.                          *)
(*                                                                        *)
(*  You should have received a copy of the GNU General Public License     *)
(*  along with this program.  If not, see <http://www.gnu.org/licenses/>. *)
(*                                                                        *)
(*  To contact author:   http://www.pmoylan.org   peter@pmoylan.org       *)
(*                                                                        *)
(**************************************************************************)

IMPLEMENTATION MODULE RelayMail;

        (********************************************************)
        (*                                                      *)
        (* Part of the SMTP server - sends mail to non-local    *)
        (*                   destinations                       *)
        (*                                                      *)
        (*  Programmer:         P. Moylan                       *)
        (*  Started:            18 November 2022                *)
        (*  Last edited:        22 November 2022                *)
        (*  Status:             Just started                    *)
        (*                                                      *)
        (********************************************************)


IMPORT Strings;

FROM SBuffers IMPORT
    (* type *)  SBuffer,
    (* proc *)  SendChar, SendLine, SendString, SendEOL, FlushOutput,
                PositiveResponse, GetLastLine;

FROM TransLog IMPORT
    (* type *)  TransactionLogID,
    (* proc *)  LogTransaction, LogTransactionL;

FROM Sockets IMPORT
    (* const*)  AF_INET, SOCK_STREAM, AF_UNSPEC, NotASocket,
    (* type *)  Socket, SockAddr,
    (* proc *)  socket, sock_errno, bind, connect, soclose;

FROM Internet IMPORT
    (* const*)  Zero8;

FROM FileOps IMPORT
    (* const*)  NoSuchChannel,
    (* type *)  ChanId,
    (* proc *)  FilePos, OpenOldFile, SetPosition, ReadLine, CloseFile;

FROM Inet2Misc IMPORT
    (* proc *)  Swap2;

FROM MiscFuncs IMPORT
    (* proc *)  AppendCard;

FROM Names IMPORT
    (* type *)  FilenameString;

FROM LowLevel IMPORT
    (* proc *)  EVAL;

(************************************************************************)

VAR
    (* The interface we use for sending mail.  It may be zero, in       *)
    (* which case we let the connect() call choose the address.         *)

    BindAddr: CARDINAL;

(************************************************************************)
(*            THE PROCEDURES THAT DELIVER THE OUTGOING MAIL             *)
(************************************************************************)

PROCEDURE WriteError (LogID: TransactionLogID);

    VAR LogLine: ARRAY [0..255] OF CHAR;

    BEGIN
        Strings.Assign ("Socket error ", LogLine);
        AppendCard (sock_errno(), LogLine);
        LogTransaction (LogID, LogLine);
    END WriteError;

(********************************************************************************)

PROCEDURE ConnectToHost (IPaddress: CARDINAL;  SMTPport: CARDINAL;
                      LogID: TransactionLogID;
                      VAR (*INOUT*) FailureReason: ARRAY OF CHAR): Socket;

    (* Tries to open a connection to the specified host.  Returns the   *)
    (* value NotASocket if we don't succeed; in this case, the string   *)
    (* FailureReason is given a value.                                  *)
    (* IPaddress is in network byte order.                              *)

    VAR s: Socket;  peer: SockAddr;

    BEGIN
        IF IPaddress <> 0 THEN
            s := socket (AF_INET, SOCK_STREAM, AF_UNSPEC);

            IF s = NotASocket THEN
                Strings.Assign ("Can't allocate socket", FailureReason);
            ELSE

                (* Bind to an address at our end if we're using a       *)
                (* specific address.                                    *)

                IF BindAddr <> 0 THEN
                    WITH peer DO
                        family := AF_INET;
                        WITH in_addr DO
                            port := 0;
                            addr := BindAddr;
                            zero := Zero8;
                        END (*WITH*);
                    END (*WITH*);

                    IF bind (s, peer, SIZE(peer)) THEN
                        WriteError (LogID);
                        LogTransactionL (LogID, "Cannot bind to local interface");
                    END (*IF*);
                END (*IF*);

                (* Socket open, connect to the client. *)

                WITH peer DO
                    family := AF_INET;
                    WITH in_addr DO
                        port := Swap2(SMTPport);
                        addr := IPaddress;
                        zero := Zero8;
                    END (*WITH*);
                END (*WITH*);

                IF connect (s, peer, SIZE(peer)) THEN

                    Strings.Assign ("Failed to connect", FailureReason);
                    soclose(s);
                    s := NotASocket;

                END (*IF*);
            END (*IF*);

        ELSE

            Strings.Assign ("500 Unknown host", FailureReason);
            s := NotASocket;

        END (*IF*);

        RETURN s;

    END ConnectToHost;

(************************************************************************)

PROCEDURE SendCommandOnly (SB: SBuffer;  ID: TransactionLogID;
                                    command: ARRAY OF CHAR;
                                    VAR (*OUT*) ConnectionLost: BOOLEAN);

    (* Sends and logs a command, but does not wait for a response.      *)

    VAR logline: ARRAY [0..511] OF CHAR;  sent: CARDINAL;

    BEGIN
        Strings.Assign ("> ", logline);
        Strings.Append (command, logline);
        LogTransaction (ID, logline);
        ConnectionLost := NOT SendLine (SB, command, sent);
        EVAL (FlushOutput (SB));
    END SendCommandOnly;

(************************************************************************)

PROCEDURE SendCommand (SB: SBuffer;  ID: TransactionLogID;  command: ARRAY OF CHAR;
                         VAR (*OUT*) ConnectionLost: BOOLEAN): BOOLEAN;

    (* Sends a command, returns TRUE if the command was sent OK and     *)
    (* a positive response was returned.                                *)

    VAR result: BOOLEAN;
        logline: ARRAY [0..511] OF CHAR;

    BEGIN
        SendCommandOnly (SB, ID, command, ConnectionLost);
        IF ConnectionLost THEN
            Strings.Assign ("Connection lost", logline);
            result := FALSE;
        ELSE
            result := PositiveResponse(SB, ConnectionLost);
            GetLastLine (SB, logline);
            Strings.Insert ("< ", 0, logline);
        END (*IF*);
        LogTransaction (ID, logline);
        RETURN result;
    END SendCommand;

(************************************************************************)
(*                          SENDING A FILE                              *)
(************************************************************************)

PROCEDURE SendFile (SB: SBuffer;  VAR (*IN*) name: FilenameString;  offset: FilePos;
                         VAR (*OUT*) ConnectionLost: BOOLEAN;
                         VAR (*OUT*) sent: CARDINAL): BOOLEAN;

    (* Sends the file, returns TRUE if it was successfully transmitted  *)
    (* and a positive response was returned.  Output parameter 'sent'   *)
    (* returns the number of bytes transmitted.                         *)

    CONST CtrlZ = CHR(26);

    VAR success, MoreToGo: BOOLEAN;  sent1, sent2: CARDINAL;
        cid: ChanId;
        buffer: ARRAY [0..2047] OF CHAR;

    BEGIN
        sent := 0;  sent1 := 0;  sent2 := 0;
        cid := OpenOldFile (name, FALSE, FALSE);
        success := cid <> NoSuchChannel;
        IF success THEN
            SetPosition (cid, offset);
        END (*IF*);
        MoreToGo := TRUE;
        WHILE success AND MoreToGo DO
            ReadLine (cid, buffer);
            IF buffer[0] = CtrlZ THEN

                MoreToGo := FALSE;

            ELSE

                success := SendString (SB, buffer, sent1) AND SendEOL(SB, sent2);
                INC (sent, sent1+sent2);

            END (*IF*);

        END (*WHILE*);
        CloseFile (cid);

        success := success AND SendChar (SB, '.', sent1) AND SendEOL (SB, sent2);
        INC (sent, sent1+sent2);
        ConnectionLost := NOT success;
        INC (sent, FlushOutput (SB));
        RETURN success AND PositiveResponse (SB, ConnectionLost);

    END SendFile;

(********************************************************************************)
(*                                INITIALISATION                                *)
(********************************************************************************)

PROCEDURE SetRelayParams (address: CARDINAL);

    (* Specifies which address we use for outgoing mail.  It may be zero, in    *)
    (* which case we revert to default assumptions.                             *)

    BEGIN
        BindAddr := address;
    END SetRelayParams;

(********************************************************************************)

END RelayMail.

