#!/usr/local/gauche/bin/gosh

(use srfi-13)
(use gauche.net)

(define (handle-smtp-response message line)
  (let ((args (string-tokenize line))
        (r-code #f)
       )
    (print message ": " line)
    (set! r-code (string->number (car args)))
    (if (or (> r-code 400) (= r-code 400)) #f #t)
  )
)

(define (bust-it out-port . args)
  (for-each
    (lambda (s) (display s out-port))
   args
  )
  (newline out-port)
)

(define (quit-smtp s exit-code)
  (bust-it (socket-output-port s) "QUIT")
  (handle-smtp-response "Quit" (read-line (socket-input-port s)))
  (exit exit-code)
)

(define (main args)
  (if (< (length args) 4)
      (begin
        (print "usage: " (car args) " remote-host helo-message mail-from rcpt-to")
	(exit 1)
      )
  )

  (let ((helo-msg  (caddr args))
        (mail-from (cadddr args))
        (rcpt-to   (cadddr (cdr args)))
        (s         (make-client-socket 'inet (cadr args) "smtp"))
        (il        #f)
       )
    (set! il (read-line (socket-input-port s)))
    (if (not (handle-smtp-response "Greeting" il)) (quit-smtp s 2))

    (bust-it (socket-output-port s) "HELO " helo-msg)
    (set! il (read-line (socket-input-port s)))
    (if (not (handle-smtp-response "Helo" il)) (quit-smtp s 2))

    (bust-it (socket-output-port s) "MAIL FROM: <" mail-from ">")
    (set! il (read-line (socket-input-port s)))
    (if (not (handle-smtp-response "Mail-from" il)) (quit-smtp s 2))

    (bust-it (socket-output-port s) "RCPT TO: <" rcpt-to ">")
    (set! il (read-line (socket-input-port s)))
    (if (not (handle-smtp-response "Rcpt-to" il)) (quit-smtp s 2))

    (quit-smtp s 0)
  )
)