diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/copy-file.tl | 45 |
1 files changed, 32 insertions, 13 deletions
diff --git a/stdlib/copy-file.tl b/stdlib/copy-file.tl index 36469412..1c01f5b5 100644 --- a/stdlib/copy-file.tl +++ b/stdlib/copy-file.tl @@ -84,8 +84,11 @@ (catch** (return (copy-file path (path-cat dest-dir (base-name path)) preserve-perms preserve-times)) - (skip `skip copying @path` (exc . args) (return)) - (retry `retry copying @path` (exc . args)))))) + (skip `skip copying @path` (exc . args) + (use args) (use exc) + (return)) + (retry `retry copying @path` (exc . args) + (use args) (use exc)))))) (defun cat-files (to-path . from-paths) (let ((buf (make-buf copy-size))) @@ -143,6 +146,7 @@ (unwind-protect (ftw from-dir (lambda (path type stat . rest) + (use rest) (while t (catch** (let* ((rel-path (rel-path from-dir path)) @@ -167,15 +171,19 @@ (remove-path tgt-path))) (do-copy-obj path tgt-path stat opts))) (return)) - (skip `skip copying @path` (exc . args) (return)) - (retry `retry copying @path` (exc . args))))) + (skip `skip copying @path` (exc . args) + (use exc) (use args) + (return)) + (retry `retry copying @path` (exc . args) + (use exc) (use args))))) ftw-phys) (whilet ((top (pop dir-stack))) (do-tweak-obj top.path top.stat opts nil))))) (defun remove-path-rec (path) (ftw path - (lambda (path type stat . rest) + (lambda (path type . rest) + (use rest) (while t (catch** (return @@ -184,13 +192,17 @@ 'remove-rec path)) (ftw-dp (rmdir path)) (t (remove-path path)))) - (skip `skip removing @path` (exc . args) (return)) - (retry `retry copying @path` (exc . args))))) + (skip `skip removing @path` (exc . args) + (use exc) (use args) + (return)) + (retry `retry copying @path` (exc . args) + (use exc) (use args))))) (logior ftw-phys ftw-depth))) (defun chmod-rec (path perm) (ftw path - (lambda (path type stat . rest) + (lambda (path type . rest) + (use rest) (while t (catch** (return @@ -199,13 +211,17 @@ 'remove-rec path)) (ftw-sl) (t (chmod path perm)))) - (skip `skip chmod @path` (exc . args) (return)) - (retry `retry chmod @path` (exc . args))))) + (skip `skip chmod @path` (exc . args) + (use exc) (use args) + (return)) + (retry `retry chmod @path` (exc . args) + (use exc) (use args))))) (logior ftw-phys))) (defun chown-rec (path uid gid) (ftw path - (lambda (path type stat . rest) + (lambda (path type . rest) + (use rest) (while t (catch** (return @@ -213,8 +229,11 @@ ((ftw-dnr ftw-ns) (error "~s: unable to access ~s" 'remove-rec path)) (t (lchown path uid gid)))) - (skip `skip chown @path` (exc . args) (return)) - (retry `retry chown @path` (exc . args))))) + (skip `skip chown @path` (exc . args) + (use exc) (use args) + (return)) + (retry `retry chown @path` (exc . args) + (use exc) (use args))))) (logior ftw-phys))) (defun touch (path : ref-path) |