blueperson <[email protected]> writes:
> 于 2014年06月10日 18:07, Peter Bex 写道:
>
>> On Tue, Jun 10, 2014 at 05:56:55PM +0800, blueperson wrote:
>>> Thanks for your help!
>>> I get a clone use "hg clone
>>> https://code.google.com/r/datenhobel-hato-egg-update/";. But get the same
>>> error "csc: invalid option `-G' " when I "make" it. I use chicken
>>> 4.8.0.3 in gentoo.
>> Have you tried simply removing the -G option? I don't know what it
>> does, and as far as I can tell there never was such an option in the
>> first place. I can't explain why this option is in the Makefile though.
>>
>> Perhaps nobody uses the Makefile at all; there's also a hato.setup file,
>> which would be used when you simply type "chicken-install" after
>> switching to the directory. It is an egg, after all, so perhaps it's
>> meant to be installed as an egg
> I have removed the -G option when I get the error first time, but it
> shows another error that seems really strange. It shows:
> "
> Syntax error (import): cannot import from undefined module
> domain-keys
> "
> But I saw the domain-keys.scm really in the directory.
Yeah the Makefile is buggy.
Please find my WIP patch attached to this email.
HTH,
Christian
diff -r d5c309011dea Makefile
--- a/Makefile Sun Apr 07 12:22:52 2013 +0900
+++ b/Makefile Tue Jun 10 14:02:49 2014 +0200
@@ -1,13 +1,13 @@
CSC=csc
-CHICKEN_OPTS=-O2 -G
+CHICKEN_OPTS=-O2
-SOURCES=hato-prob.scm hato-mime.scm hato-archive.scm hato-smtp.scm \
- hato-base64.scm quoted-printable.scm domain-keys.scm \
- html-parser.scm hato-i3db.scm hato-uri.scm user-env.scm dns.scm \
- hato-spf.scm hato-pop.scm hato-imap.scm hato-daemon.scm \
+SOURCES=quoted-printable.scm hato-i3db.scm hato-base64.scm hato-mime.scm hato-token.scm hato-prob.scm hato-archive.scm dns.scm hato-smtp.scm \
+ domain-keys.scm \
+ hato-uri.scm user-env.scm \
+ hato-spf.scm hato-md5.scm hato-pop.scm hato-imap.scm let-keywords.scm hato-daemon.scm \
hato-db.scm hato-config.scm hato-rfc3028.scm hato-date.scm \
- hato-nntp.scm hato-filter.scm lru-cache.scm
+ hato-nntp.scm safe-io.scm hato-log.scm hato-utils.scm hato-filter-env.scm let-args.scm safe-eval.scm
MODULES=$(SOURCES:%.scm=%.so)
INSTALL = /usr/bin/install -c
@@ -28,7 +28,7 @@
modules: $(MODULES)
%.so: %.scm
- $(CSC) $(CHICKEN_OPTS) -s $< 2>&1
+ $(CSC) $(CHICKEN_OPTS) -J -s $< 2>&1
########################################################################
@@ -67,8 +67,8 @@
$(INSTALL) hato-mta $(BIN_DIR)
$(INSTALL) hato-classify $(BIN_DIR)
$(INSTALL) hato-fetch $(BIN_DIR)
- $(INSTALL) $(MODULES) $(MODULES:%.so=%.exports) \
- `chicken-setup -repository`
+ $(INSTALL) $(MODULES) $(MODULES:%.so=%.import.scm) \
+ `chicken-install -repository`
uninstall:
$(RM) -f $(BIN_DIR)/hato-mta
diff -r d5c309011dea domain-keys.scm
--- a/domain-keys.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/domain-keys.scm Tue Jun 10 14:02:49 2014 +0200
@@ -42,13 +42,13 @@
;; Convenience routine, returns a complete new MAIL-TEXT string, signed
;; as with the same arguments to DOMAIN-KEY-SIGNATURE.
-(require-library dns hato-base64 hato-mime)
+(require-library miscmacros dns hato-base64 hato-mime)
(module domain-keys
(domain-key-verify domain-key-sign domain-key-signature
dkey-normalize-simple dkey-normalize-nofws)
-(import scheme chicken extras ports data-structures regex posix dns hato-base64 hato-mime)
+(import scheme chicken extras miscmacros ports data-structures regex posix dns hato-base64 hato-mime)
(define (string-strip-whitespace str)
(string-translate str " \t"))
@@ -225,7 +225,7 @@
(let ((res
(base64-encode-string
(read-string #f in))))
- (process-wait pid)
+ (ignore-values (process-wait pid))
res))))
(define (domain-key-signature mail-string private-key-file . o)
diff -r d5c309011dea hato-archive.scm
--- a/hato-archive.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/hato-archive.scm Tue Jun 10 14:02:49 2014 +0200
@@ -78,7 +78,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (set-file-position! fd where . o)
+#;(define (set-file-position! fd where . o)
(set! (file-position fd) (if (pair? o) (cons where o) where)))
(define (current-seconds-string)
diff -r d5c309011dea hato-classify.scm
--- a/hato-classify.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/hato-classify.scm Tue Jun 10 14:02:49 2014 +0200
@@ -3,7 +3,7 @@
;; Copyright (c) 2005 Alex Shinn. All rights reserved.
;; BSD-style license: http://www.debian.org/misc/bsd.license
-(include "let-args.scm")
+(use let-args)
(cond-expand
(static
diff -r d5c309011dea hato-i3db.scm
--- a/hato-i3db.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/hato-i3db.scm Tue Jun 10 14:02:49 2014 +0200
@@ -23,12 +23,12 @@
(import scheme chicken extras posix lolevel srfi-4)
-(define (set-file-position! fd where . o)
+#;(define (set-file-position! fd where . o)
(set! (file-position fd) (if (pair? o) (cons where o) where)))
(define (pointer-u24-ref ptr)
(bitwise-ior (arithmetic-shift (pointer-u16-ref ptr) 8)
- (pointer-u8-ref (pointer-offset ptr 2))))
+ (pointer-u8-ref (pointer+ ptr 2))))
(define (pointer-u24-set! ptr val)
(pointer-u16-set! ptr (arithmetic-shift val -8))
@@ -109,15 +109,15 @@
(ptr (memory-mapped-file-pointer mmap))
(magic (pointer-u32-ref ptr))
((= magic *i3db-magic*))
- (version (pointer-u32-ref (pointer-offset ptr 4)))
+ (version (pointer-u32-ref (pointer+ ptr 4)))
((= version *i3db-version*))
- (spam (pointer-u32-ref (pointer-offset ptr 8)))
- (ham (pointer-u32-ref (pointer-offset ptr 12)))
- (mask (pointer-u32-ref (pointer-offset ptr 16)))
+ (spam (pointer-u32-ref (pointer+ ptr 8)))
+ (ham (pointer-u32-ref (pointer+ ptr 12)))
+ (mask (pointer-u32-ref (pointer+ ptr 16)))
((= mask (inexact->exact (- (expt 2 (* 8 key-size)) 1))))
- (bytes (pointer-u32-ref (pointer-offset ptr 20)))
+ (bytes (pointer-u32-ref (pointer+ ptr 20)))
((= bytes value-size))
- (salt (pointer-u32-ref (pointer-offset ptr 24)))
+ (salt (pointer-u32-ref (pointer+ ptr 24)))
(reader (bytes->reader bytes))
(writer (bytes->writer bytes)))
;;(printf "make-i3db ~S ~S ~S ~S ~S ~S\n" fd spam ham mask bytes salt)
@@ -144,12 +144,12 @@
fd))
(ptr (memory-mapped-file-pointer mmap)))
(pointer-u32-set! ptr *i3db-magic*)
- (pointer-u32-set! (pointer-offset ptr 4) *i3db-version*)
- (pointer-u32-set! (pointer-offset ptr 8) 0)
- (pointer-u32-set! (pointer-offset ptr 12) 0)
- (pointer-u32-set! (pointer-offset ptr 16) mask)
- (pointer-u32-set! (pointer-offset ptr 20) bytes)
- (pointer-u32-set! (pointer-offset ptr 24) salt)
+ (pointer-u32-set! (pointer+ ptr 4) *i3db-version*)
+ (pointer-u32-set! (pointer+ ptr 8) 0)
+ (pointer-u32-set! (pointer+ ptr 12) 0)
+ (pointer-u32-set! (pointer+ ptr 16) mask)
+ (pointer-u32-set! (pointer+ ptr 20) bytes)
+ (pointer-u32-set! (pointer+ ptr 24) salt)
;;(printf "make-i3db ~S ~S ~S ~S ~S ~S\n" fd 0 0 mask bytes salt)
(make-i3db fd mmap ptr 0 0 mask bytes salt reader writer)))
(begin
@@ -174,15 +174,15 @@
(let ((ptr (i3db-ptr db))
(writer (i3db-writer db))
(pos (i3db-index db key)))
- (writer (pointer-offset ptr pos) s)
- (writer (pointer-offset ptr (+ pos (i3db-bytes db))) h)))
+ (writer (pointer+ ptr pos) s)
+ (writer (pointer+ ptr (+ pos (i3db-bytes db))) h)))
(define (i3db-ref db key)
(let ((ptr (i3db-ptr db))
(reader (i3db-reader db))
(pos (i3db-index db key)))
- (let* ((s (reader (pointer-offset ptr pos)))
- (h (reader (pointer-offset ptr (+ pos (i3db-bytes db))))))
+ (let* ((s (reader (pointer+ ptr pos)))
+ (h (reader (pointer+ ptr (+ pos (i3db-bytes db))))))
(values s h))))
(define (i3db-update! db key s-off h-off)
@@ -192,16 +192,16 @@
(mask (i3db-mask db))
(pos (i3db-index db key))
(bytes (i3db-bytes db)))
- (let* ((s (reader (pointer-offset ptr pos)))
- (h (reader (pointer-offset ptr (+ pos bytes))))
+ (let* ((s (reader (pointer+ ptr pos)))
+ (h (reader (pointer+ ptr (+ pos bytes))))
(s2 (fxmax 0 (fx+ s s-off)))
(h2 (fxmax 0 (fx+ h h-off)))
(overflow? (or (> s2 mask) (> h2 mask)))
(s3 (if overflow? (fx/ s2 2) s2))
(h3 (if overflow? (fx/ h2 2) h2)))
(unless (and (= s s2) (= h h2))
- (writer (pointer-offset ptr pos) s3)
- (writer (pointer-offset ptr (+ pos bytes)) h3)))))
+ (writer (pointer+ ptr pos) s3)
+ (writer (pointer+ ptr (+ pos bytes)) h3)))))
(define (i3db-close db)
(if (memory-mapped-file? (i3db-mmap db))
diff -r d5c309011dea hato-mta.scm
--- a/hato-mta.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/hato-mta.scm Tue Jun 10 14:02:49 2014 +0200
@@ -1,4 +1,4 @@
-#! /usr/local/bin/csi -script
+#! /home/ckellerm/chickens/use-this/bin/csi -script
;; hato-mta.scm -- a mail server in Scheme
;;
;; Copyright (c) 2005-2008 Alex Shinn. All rights reserved.
@@ -9,12 +9,13 @@
(use
extras regex posix srfi-1 srfi-13 srfi-18 srfi-69 tcp tcp-server lolevel
domain-keys lru-cache user-env hato-daemon hato-config hato-db
- hato-prob hato-smtp hato-filter hato-spf hato-rfc3028 dns utils
+ hato-prob hato-smtp hato-filter-env hato-spf hato-rfc3028 dns utils
hato-archive hato-mime sandbox
)
-(include "let-args.scm")
-(include "hato-log.scm")
+(use let-args hato-log)
+
+
(define undef (if #f #f))
(define-inline (defined? x) (not (eq? x undef)))
@@ -47,10 +48,15 @@
;; variant CONDITION-CASE* which does always restore the ports. This
;; assumes the exception is caught and not passed to the next handler.
+#;
(define-macro (condition-case* . x)
`(save-current-io-ports
(lambda () (condition-case ,@x))))
+(define-syntax condition-case*
+ (syntax-rules ()
+ ((_ something ...) (save-current-io-ports
+ (lambda () (condition-case something ...))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; I/O Utils
@@ -975,19 +981,35 @@
(exn ()
(log-notice "couldn't delete pid file: ~A" (exception-message exn))))
(log-close)
- (exit))
+ (exit 0))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Handle options and config
+#;
(define-macro (default . o) ; like or but checks for first defined value
(cond
- ((null? o) #f)
- ((null? (cdr o)) (car o))
- (else
- (let ((tmp (gensym)))
- `(let ((,tmp ,(car o)))
- (if (eq? ,tmp undef) (default ,@(cdr o)) ,tmp))))))
+ ((null? o) #f)
+ ((null? (cdr o)) (car o))
+ (else
+ (let ((tmp (gensym)))
+ `(let ((,tmp ,(car o)))
+ (if (eq? ,tmp undef) (default ,@(cdr o)) ,tmp))))))
+
+ (define-syntax default
+ (er-macro-transformer
+ (lambda (e r c)
+ (let ((o (cdr e)))
+ (cond
+ ((null? o) #f)
+ ((null? (cdr o)) (car o))
+ (else
+ (let ((tmp (gensym))
+ (%let (r 'let))
+ (%if (r 'if))
+ (%eq? (r 'eq?)))
+ `(,%let ((,tmp ,(car o)))
+ (,%if (,%eq? ,tmp undef) (default ,@(cdr o)) ,tmp)))))) )))
(define (setup-file-system)
(create-directory* hato-spool-directory)
diff -r d5c309011dea hato-prob.scm
--- a/hato-prob.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/hato-prob.scm Tue Jun 10 14:02:49 2014 +0200
@@ -34,7 +34,7 @@
(import html-parser hato-i3db hato-mime hato-token)
(include "write-number.scm")
-(define (set-file-position! fd where . o)
+#;(define (set-file-position! fd where . o)
(set! (file-position fd) (if (pair? o) (cons where o) where)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff -r d5c309011dea hato-spf.scm
--- a/hato-spf.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/hato-spf.scm Tue Jun 10 14:02:49 2014 +0200
@@ -61,7 +61,7 @@
(lp (cdr ls) version default res))))))))))))
(define (hato-spf-verify? tcp-address helo-domain from-domain msg . o)
- (let ((rule (lru-ref! hato-spf-cache from-domain hato-spf-rule)))
+ (let ((rule (lru-cache-ref hato-spf-cache from-domain hato-spf-rule)))
(or (not (pair? rule))
(not (= 1 (car rule)))
(let ((headers (if (pair? o)
diff -r d5c309011dea hato-utils.scm
--- a/hato-utils.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/hato-utils.scm Tue Jun 10 14:02:49 2014 +0200
@@ -126,6 +126,7 @@
(exit n))
(define (die . args)
+ (fprintf (current-error-port) "Die called with ~a args~%" args)
(apply die-with-exit-code (if (number? (car args)) args (cons 1 args))))
)
diff -r d5c309011dea let-args.scm
--- a/let-args.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/let-args.scm Tue Jun 10 14:02:49 2014 +0200
@@ -8,7 +8,7 @@
(module let-args (let-args)
(import scheme chicken data-structures)
-(import-for-syntax srfi-1)
+(import-for-syntax srfi-1 chicken scheme)
(define-for-syntax (split-improper-list ls)
(let loop ((l ls) (res '()))
diff -r d5c309011dea tests/mta-test.scm
--- a/tests/mta-test.scm Sun Apr 07 12:22:52 2013 +0900
+++ b/tests/mta-test.scm Tue Jun 10 14:02:49 2014 +0200
@@ -167,6 +167,7 @@
(define (with-test-server-from-dir dir thunk)
+ (fprintf (current-error-port) "Testing in ~a~%" dir)
;; clean out any previous test files (keep the log files around)
(for-each
(lambda (d) (if (directory? d) (for-each delete-file (ls-a d))))
@@ -192,7 +193,7 @@
(zero?
(system
(sprintf
- "cd .. && ./hato-mta.scm -d --virtual --port ~A --base tests/~A/root/"
+ "../hato-mta -d --virtual --port ~A --base tests/~A/root/"
test-port dir))))
;; do whatever
_______________________________________________
Chicken-users mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-users
