mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
53 lines
2.1 KiB
Scheme
53 lines
2.1 KiB
Scheme
|
|
;;> Copies the file \var{from} to \var{to}.
|
|
|
|
(define (copy-file from to)
|
|
(let ((in (open-binary-input-file from))
|
|
(out (open-binary-output-file to)))
|
|
(let lp ()
|
|
(let ((n (read-u8 in)))
|
|
(cond ((eof-object? n) (close-input-port in) (close-output-port out))
|
|
(else (write-u8 n out) (lp)))))))
|
|
|
|
(define (call-with-temp-file template proc)
|
|
(let ((base (string-append
|
|
"/tmp/" (path-strip-extension template)
|
|
"-" (number->string (current-process-id)) "-"
|
|
(number->string (exact (round (current-second)))) "-"))
|
|
(ext (or (path-extension template) "tmp")))
|
|
(let lp ((i 0))
|
|
(let ((path (string-append base (number->string i) "." ext)))
|
|
(cond
|
|
((> i 100) ;; give up after too many tries regardless
|
|
(die 2 "Repeatedly failed to generate temp file in /tmp"))
|
|
((file-exists? path)
|
|
(lp (+ i 1)))
|
|
(else
|
|
(let ((fd (open path
|
|
(bitwise-ior open/write open/create open/exclusive))))
|
|
(if (not fd)
|
|
(if (file-exists? path) ;; created between test and open
|
|
(lp (+ i 1))
|
|
(die 2 "Couldn't generate temp file in /tmp " path))
|
|
(let* ((out (open-output-file-descriptor fd #o700))
|
|
(res (proc path out)))
|
|
(close-output-port out)
|
|
(delete-file path)
|
|
res)))))))))
|
|
|
|
(define (call-with-temp-dir template proc)
|
|
(let ((base (string-append
|
|
"/tmp/" template
|
|
"-" (number->string (current-process-id)) "-"
|
|
(number->string (exact (round (current-second)))) "-")))
|
|
(let lp ((i 0))
|
|
(let ((path (string-append base (number->string i))))
|
|
(cond
|
|
((> i 100) ;; give up after too many tries
|
|
(die 2 "Repeatedly failed to generate temp dir in /tmp " path))
|
|
((file-exists? path)
|
|
(lp (+ i 1)))
|
|
((create-directory path #o700)
|
|
(let ((res (proc path)))
|
|
(delete-file-hierarchy path)
|
|
res)))))))
|