schemedoc regexps - 1
This commit is contained in:
erana
parent
92499b2635
commit
bffa65529b
|
|
@ -26,34 +26,22 @@
|
|||
;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
|
||||
;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
;;#!/home/erana/scheme/bin/scsh -ds \
|
||||
;;!#
|
||||
|
||||
;;#!/home/erana/scheme/bin/scsh \
|
||||
;;-lm tmail.scm -o mail-daemon -s
|
||||
|
||||
(load "trecords.scm")
|
||||
(load "tclient.scm")
|
||||
(load "tserver.scm")
|
||||
(load "tforks.scm")
|
||||
(display "FIXMES: mail-daemon structure needs carriage return statement")
|
||||
(newline)
|
||||
|
||||
(define rc (make-daemon-record
|
||||
(delay "localhost") ;; virtual host
|
||||
(delay 1110)
|
||||
(delay (open-socket (force (port rc))))
|
||||
(delay "POP3 tmail server ready")
|
||||
(delay "+OK ")
|
||||
(delay "APOP ")
|
||||
(delay "STAT")
|
||||
(delay "LIST")
|
||||
(delay "+OK POP3 server signing off")
|
||||
(delay "Exceeded maximum transactions.")
|
||||
(delay "500 Command not understood.")
|
||||
(delay "HELO")
|
||||
(delay "EHLO")))
|
||||
(run-daemon-child rc)
|
||||
"localhost" ;; virtual host
|
||||
1110
|
||||
#f
|
||||
"POP3 tmail server ready"
|
||||
"+OK "
|
||||
"APOP "
|
||||
"STAT"
|
||||
"LIST"
|
||||
"+OK POP3 server signing off"
|
||||
))
|
||||
(run-daemon-child-mail rc)
|
||||
|
||||
(display "mail-daemon ends.")
|
||||
(newline)
|
||||
|
|
|
|||
|
|
@ -26,52 +26,49 @@
|
|||
;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
|
||||
;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
(load "util.scm")
|
||||
(load "trecords.scm")
|
||||
(load "tserver.scm")
|
||||
(load "tmailbox-load.scm")
|
||||
|
||||
;; You can spawn this
|
||||
(define (run-daemon-child-mail rec)
|
||||
(let ((*hostname (hostname rec))
|
||||
(*port (port rec))
|
||||
(*socket (socket rec))
|
||||
(*motd (motd rec))
|
||||
(*ack (ack rec))
|
||||
(*apop (apop rec))
|
||||
(*stat (stat rec))
|
||||
(*list (list rec))
|
||||
(*bye (bye rec)))
|
||||
|
||||
(define (run-daemon-child rec)
|
||||
(display "Opening listening socket on host : ")
|
||||
(display (force (hostname rec)))
|
||||
(display " port unknown at this stage, default 1110 ")
|
||||
(display " ...")
|
||||
(newline)
|
||||
(fork-and-forget
|
||||
(let ((socket (force (sock rec))))
|
||||
(begin
|
||||
(
|
||||
(lambda (request portnumber)
|
||||
(set! *socket (open-socket *port))
|
||||
|
||||
(for-each display '("Opening listening socket on host : "
|
||||
*hostname
|
||||
" port : "
|
||||
*port
|
||||
(eoln)))
|
||||
|
||||
((lambda (portnumber)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(socket-accept socket))
|
||||
(socket-accept *socket))
|
||||
(lambda (in out)
|
||||
(write request out)
|
||||
(do ((i 0 (+ i 1)))
|
||||
((> i 9)(display "Quitting mail daemon child.")(newline))
|
||||
;; (iterate loop
|
||||
;; ((count* i 0))
|
||||
;; ()
|
||||
;; (if (>= i 10)
|
||||
;; (display "Quitting mail daemon child.")(newline)
|
||||
|
||||
|
||||
(call-with-values ;; FIXME (let ((answer2 (read in)))
|
||||
(write *motd out)
|
||||
(do ((i 0 (+ i 1))) ;; iterate
|
||||
((> i 9)(display *bye)(newline))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(list (read in)(read in)))
|
||||
'((read in)(read in)(read in)))
|
||||
(lambda (answer)
|
||||
(let ((answer2 (car answer))
|
||||
(answer3 (if (not (null? (cdr answer)))
|
||||
(cadr answer)
|
||||
'foo)))
|
||||
(display "Asked something : ")(display (symbol->string answer2))(display " ")(display answer3)(newline)
|
||||
(for-each display '((servermsg) (symbol->string answer2) " " answer3 (eoln)))
|
||||
(if (symbol? answer2)
|
||||
(cond ((eq? 'APOP answer2)
|
||||
(write mailbox-contents out)
|
||||
;; FIXME write "" to user's mailbox file
|
||||
;;(let ((out2 (open-output-file (string-append spooldirectory (getenv "USER")))))
|
||||
;; (write out2 ""))
|
||||
)
|
||||
((eq? 'STAT answer2)
|
||||
#t)
|
||||
|
|
@ -81,9 +78,7 @@
|
|||
(let ((idx (string->number (symbol->string answer3))))
|
||||
(if idx
|
||||
(write (tmail-get-mail-with-index (getenv "USER") idx) out))))
|
||||
;; for brokeness
|
||||
((eq? 'USER answer2)
|
||||
;;FIXME overflow
|
||||
(let ((username (if (number? answer3)
|
||||
(number->string answer3)
|
||||
(symbol->string answer3))))
|
||||
|
|
@ -95,24 +90,20 @@
|
|||
(symbol->string answer3))))
|
||||
(write "+OK password accepted - not implemented" out)))
|
||||
((eq? 'QUIT answer2)
|
||||
(write (force (BYE rec)) out)
|
||||
(write *bye out)
|
||||
(close-input-port in)
|
||||
(close-socket socket)
|
||||
(close-socket *socket)
|
||||
(close-output-port out)
|
||||
(exit))
|
||||
(else
|
||||
(write (force (ERROR500 rec)) out))
|
||||
(write (errormsg) out))
|
||||
))
|
||||
))))
|
||||
(write (force (SPAWNEND rec)) out)
|
||||
(write (force (BYE rec)) out)
|
||||
|
||||
(write *bye out)
|
||||
(close-input-port in)
|
||||
(close-socket socket)
|
||||
(close-socket *socket)
|
||||
(close-output-port out)
|
||||
|
||||
(exit)
|
||||
|
||||
)))
|
||||
(force (MOTD rec)) (port rec))
|
||||
))))
|
||||
*port)
|
||||
))
|
||||
|
|
@ -28,30 +28,18 @@
|
|||
|
||||
(define :daemon-record
|
||||
(make-record-type 'daemon-record
|
||||
'(hostname port sock MOTD ACK APOP STAT LIST BYE SPAWNEND ERROR500 HELO EHLO)))
|
||||
'(hostname port sock motd ack apop stat list bye)))
|
||||
(define make-daemon-record
|
||||
(record-constructor :daemon-record
|
||||
'(hostname port sock MOTD ACK APOP STAT LIST BYE SPAWNEND ERROR500 HELO EHLO)))
|
||||
;; (define make-daemon-record-default
|
||||
;; (record-constructor :daemon-record
|
||||
;; '(hostname
|
||||
;; 1025 #f
|
||||
;; "Hello."
|
||||
;; "OK."
|
||||
;; "Bye."
|
||||
;; "500 Command not understood."
|
||||
;; "EHLO Server ready.")))
|
||||
'(hostname port sock motd ack apop stat list bye)))
|
||||
|
||||
(define hostname (record-accessor :daemon-record 'hostname))
|
||||
(define port (record-accessor :daemon-record 'port))
|
||||
(define sock (record-accessor :daemon-record 'sock))
|
||||
(define MOTD (record-accessor :daemon-record 'MOTD))
|
||||
(define ACK (record-accessor :daemon-record 'ACK))
|
||||
(define APOP (record-accessor :daemon-record 'APOP))
|
||||
(define STAT (record-accessor :daemon-record 'STAT))
|
||||
(define LIST (record-accessor :daemon-record 'LIST))
|
||||
(define BYE (record-accessor :daemon-record 'BYE))
|
||||
(define SPAWNEND (record-accessor :daemon-record 'SPAWNEND))
|
||||
(define ERROR500 (record-accessor :daemon-record 'ERROR500))
|
||||
(define HELO (record-accessor :daemon-record 'HELO))
|
||||
(define EHLO (record-accessor :daemon-record 'EHLO))
|
||||
(define motd (record-accessor :daemon-record 'motd))
|
||||
(define ack (record-accessor :daemon-record 'ack))
|
||||
(define apop (record-accessor :daemon-record 'apop))
|
||||
(define stat (record-accessor :daemon-record 'stat))
|
||||
(define list (record-accessor :daemon-record 'Llist))
|
||||
(define bye (record-accessor :daemon-record 'bye))
|
||||
|
||||
|
|
|
|||
|
|
@ -26,6 +26,6 @@
|
|||
;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
|
||||
;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
(define (aspecterror) (display " message not understood. "))
|
||||
|
||||
|
||||
(define (errormsg) (display " message not understood. "))
|
||||
(define (eoln) (string #\newline))
|
||||
(define (servermsg) (display "::message::"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue