;; Copyright (C) 2022, Matt Welland
;;   All rights reserved.
;; 
;;   Redistribution and use in source and binary forms, with or without
;;   modification, are permitted provided that the following conditions are met:
;; 
;;   Redistributions of source code must retain the above copyright notice, this
;;   list of conditions and the following disclaimer.
;;   Redistributions in binary form must reproduce the above copyright notice,
;;   this list of conditions and the following disclaimer in the documentation
;;   and/or other materials provided with the distribution.
;;   Neither the name of the author nor the names of its contributors may be
;;   used to endorse or promote products derived from this software without
;;   specific prior written permission.
;; 
;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;;   AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;;   IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;   ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
;;   LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;;   CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;;   SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;   INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;;   CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;;   ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;   POSSIBILITY OF SUCH DAMAGE.

(module freemail

    *

  (import
    scheme
    (chicken io)
    (chicken tcp)
    (chicken base)
    (chicken string)
    srfi-1
    srfi-18
    base64
    regex
    matchable
    )
  
;; (define-values (i o) (tcp-connect "localhost" 4242))
;; (write-line "Good Bye!" o)
;; (print (read-line i))

(define port (make-parameter 4025))
(define host (make-parameter "localhost")) ;; 127.0.0.1"))

;; send conc of str with \r\n
;;
(define (send-and-print p . str)
  (let* ((fullstr (conc (apply conc str) "\r\n")))
    (display fullstr p)
    (print "Sending: \""fullstr"\"")))

(define *inq* '())
(define *inq-mutex* (make-mutex))

;; wait until val (a regex) matches an item in the input queue
;; then clear the queue
;;
(define (input-wait i val)
  (print "Waiting for: "val)
  (let loop ()
    (let ((inl (read-line i)))
      (if (string-match val inl)
	  (print "Got: "inl)
	  (begin
	    (print "Received: "inl)
	    (loop))
	  ))))

(define (addr->baseaddress addr)
  (match (string-match "^(\\S+)\\s+(\\S+)\\s+<(.*)>$" addr)
    ((_ firstname lastname baseaddress)
     baseaddress)
    (else
     addr)))
  
;; address format "First Last <first_last@something.freenet>"
;;
(define (send-freemail to-addr my-addr subject date msg passwd)
  (let-values (((i o)(tcp-connect "localhost" (port))))
    (send-and-print o "ehlo")
    (input-wait i ".*ready.*")
    (send-and-print o "auth login plain")
    (input-wait i ".*LOGIN PLAIN.*")
    (input-wait i ".*VXNlcm5hbWU6.*")
    (send-and-print o (base64-encode (addr->baseaddress my-addr)))
    ;; (newline o)
    (input-wait i ".*UGFzc3dvcmQ6.*")
    (send-and-print o (base64-encode passwd))
    ;; (newline o)
    (input-wait i ".*Authenticated.*")
    (send-and-print o "mail from: "(addr->baseaddress my-addr))
    (input-wait i ".*OK.*")
    (send-and-print o "rcpt to: "(addr->baseaddress to-addr))
    (input-wait i ".*OK.*")
    (send-and-print o "data")
    (input-wait i ".*Go crazy.*")
    (send-and-print o "Date: "date)
    (send-and-print o "From: "my-addr)
    (send-and-print o "To: "to-addr)
    (if subject
	(begin
	  (send-and-print o "Subject: "subject)))
    (send-and-print o "")
    ;; (input-wait i ".*")
    (for-each
     (lambda (l)
       (send-and-print o l)
       (thread-sleep! 0.1))
     (string-split msg "\n"))
    (send-and-print o "")
    (send-and-print o ".")
    (input-wait i ".*")
    (send-and-print o "quit")
    (input-wait i ".*")
    ;; (print (read-line i))
    (close-input-port i)
    (close-output-port o)))


)