~ chicken-core (chicken-5) 72ce83d159afc15d9ffe30bf8707a7151a0f5640
commit 72ce83d159afc15d9ffe30bf8707a7151a0f5640
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Dec 2 08:32:12 2010 -0500
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Dec 2 08:32:12 2010 -0500
removed broken mail-sending stuff from chicken-bug
diff --git a/chicken-bug.scm b/chicken-bug.scm
index dc25d4a7..60fb0cc0 100644
--- a/chicken-bug.scm
+++ b/chicken-bug.scm
@@ -29,14 +29,6 @@
(define-constant +bug-report-file+ "chicken-bug-report.~a-~a-~a")
-(define-constant +fallbackdestinations+
- "chicken-janitors@nongnu.org\nchicken-hackers@nongnu.org\nchicken-users@nongnu.org")
-
-(define-constant +destination+ "chicken-janitors@nongnu.org")
-(define-constant +mxservers+ '() ; XXX temporarily disabled
- #;(list "mx10.gnu.org" "mx20.gnu.org"))
-(define-constant +send-tries+ 3)
-
(define-foreign-variable +cc+ c-string "C_TARGET_CC")
(define-foreign-variable +cxx+ c-string "C_TARGET_CXX")
(define-foreign-variable +c-include-path+ c-string "C_INSTALL_INCLUDE_HOME")
@@ -150,122 +142,16 @@ EOF
(begin
(print msg)
(collect-info))
- (try-mail
- +mxservers+
+ (generate-report
(sprintf +bug-report-file+ (+ 1900 yr) (justify mon) (justify day))
- (mail-headers)
(with-output-to-string
(lambda ()
(print msg)
(collect-info))))))))
- ;(let* ((file (sprintf +bug-report-file+ (+ 1900 yr) (justify mon) (justify day)))
- ; (port (if stdout (current-output-port) (open-output-file file))))
- ;(with-output-to-port port
- ; (lambda ()
- ; (print msg)
- ; (collect-info) ) )
- ;(unless stdout
- ; (close-output-port port)
- ; (print "\nA bug report has been written to `" file "'. Please send it to")
- ; (print "one of the following addresses:\n\n" +destinations+) ) ) ) ) )
-
-(define (try-mail servs fname hdrs msg)
- (if (null? servs)
- (begin
- (with-output-to-file fname
- (lambda () (print msg)))
- ;XXX temporarily disabled:
- ;(print "\nCould not send mail automatically!\n")
- (print "\nA bug report has been written to `" fname "'. Please send it to")
- (print "one of the following addresses:\n\n" +fallbackdestinations+))
- (or (send-mail (car servs) msg hdrs fname)
- (try-mail (cdr servs) fname hdrs msg))))
-
-(define (mail-date-str tm)
- (string-append
- (case (vector-ref tm 6)
- ((0) "Sun, ")
- ((1) "Mon, ")
- ((2) "Tue, ")
- ((3) "Wed, ")
- ((4) "Thu, ")
- ((5) "Fri, ")
- ((6) "Sat, "))
- (string-pad (number->string (vector-ref tm 3)) 2 #\0)
- (case (vector-ref tm 4)
- ((0) " Jan ")
- ((1) " Feb ")
- ((2) " Mar ")
- ((3) " Apr ")
- ((4) " May ")
- ((5) " Jun ")
- ((6) " Jul ")
- ((7) " Aug ")
- ((8) " Sep ")
- ((9) " Oct ")
- ((10) " Nov ")
- ((11) " Dec "))
- (number->string (+ 1900 (vector-ref tm 5)))
- " "
- (string-pad (number->string (vector-ref tm 2)) 2 #\0)
- ":"
- (string-pad (number->string (vector-ref tm 1)) 2 #\0)
- ":"
- (string-pad (number->string (vector-ref tm 0)) 2 #\0)
- " +0000"))
-
-(define (mail-headers)
- (string-append
- "Date: " (mail-date-str (seconds->utc-time (current-seconds))) "\r\n"
- "From: \"chicken-bug user\" <chicken-bug-command@callcc.org>\r\n"
- "To: \"Chicken Janitors\" <chicken-janitors@nongnu.org>\r\n"
- "Subject: Automated chicken-bug output -- "))
-
-(define (mail-read i o)
- (let ((v (condition-case (read-line i)
- (var () (close-input-port i) (close-output-port o) #f))))
- (if v
- (if (char-numeric? (string-ref v 0))
- (string->number (substring v 0 3))
- (mail-read i o))
- #f)))
-
-(define (mail-write i o m)
- (let ((v (condition-case (display m o)
- (var () (close-input-port i) (close-output-port o) #f))))
- (if v
- (mail-read i o)
- #f)))
-
-(define (mail-check i o v e k)
- (if (and v (= v e))
- #t
- (begin
- (close-input-port i)
- (close-output-port o)
- (k #f))))
-(define (send-mail serv msg hdrs fname)
- (call/cc
- (lambda (return)
- (do ((try 1 (add1 try)))
- ((> try +send-tries+))
- (print* "connecting to " serv ", try #" try " ...")
- (receive (i o)
- (tcp-connect serv 25)
- (call-with-current-continuation
- (lambda (k)
- (mail-check i o (mail-read i o) 220 k)
- (mail-check i o (mail-write i o "HELO callcc.org\r\n") 250 k)
- (mail-check i o (mail-write i o "MAIL FROM:<chicken-bug-command@callcc.org>\r\n") 250 k)
- (mail-check i o (mail-write i o "RCPT TO:<chicken-janitors@nongnu.org>\r\n") 250 k)
- (mail-check i o (mail-write i o "DATA\r\n") 354 k)
- (mail-check i o (mail-write i o (string-append hdrs fname "\r\n\r\n" msg "\r\n.\r\n")) 250 k)
- (display "QUIT" o)
- (close-input-port i)
- (close-output-port o)
- (print "ok.\n\nBug report successfully mailed to the Chicken maintainers.\nThank you very much!\n\n")
- (return #t))))
- (print " failed.")))))
+(define (generate-report fname msg)
+ (with-output-to-file fname
+ (lambda () (print msg)))
+ (print "\nA bug report has been written to `" fname "'."))
(main (command-line-arguments))
Trap