chown/chgrp/chmod: do not follow symlinks during -R recursion
ober
bdf24ba4b4717173987a655db436286bbd205aef
--- a/lib/jerboa-coreutils/chgrp.sls +++ b/lib/jerboa-coreutils/chgrp.sls @@ -18,7 +18,6 @@ (with-catch (lambda (e) -1) (lambda () (ffi-getgrnam-gid-c name)))) - (def (ffi-stat-isdir path) (if (file-directory? path) 1 0)) (def (resolve-group-id spec) (let ([n (string->number spec)]) (if n (inexact->exact n) (ffi-getgrnam-gid spec)))) @@ -32,22 +31,32 @@ (set! exit-status 1)] [verbose (displayln "changed group of '" path "'")]))) (def (do-chgrp-recursive path gid no-deref verbose) - (do-chgrp path gid no-deref verbose) - (when (= (ffi-stat-isdir path) 1) - (with-catch - (lambda (e) - (warn "cannot open directory '~a'" path) - (set! exit-status 1)) - (lambda () - (let ([files (directory-list path)]) - (for-each - (lambda (name) - (do-chgrp-recursive - (string-append path "/" name) - gid - no-deref - verbose)) - files)))))) + (let ([ftype (ffi-lstat-type path)]) + (let ([rc ((if (or no-deref (= ftype 2)) + ffi-chgrp-lchown + ffi-chgrp-chown) + path + gid)]) + (cond + [(< rc 0) + (warn "cannot chgrp '~a'" path) + (set! exit-status 1)] + [verbose (displayln "changed group of '" path "'")])) + (when (= ftype 1) + (with-catch + (lambda (e) + (warn "cannot open directory '~a'" path) + (set! exit-status 1)) + (lambda () + (let ([files (directory-list path)]) + (for-each + (lambda (name) + (do-chgrp-recursive + (string-append path "/" name) + gid + no-deref + verbose)) + files))))))) (def (main . args) (parameterize ([program-name "chgrp"]) (init-security!) @@ -104,4 +113,9 @@ ffi-getgrnam-gid-c "coreutils_getgrnam_gid" (string) + int) + (define-coreutils-foreign + ffi-lstat-type + "coreutils_lstat_type" + (string) int)) --- a/lib/jerboa-coreutils/chmod.sls +++ b/lib/jerboa-coreutils/chmod.sls @@ -15,8 +15,6 @@ (jerboa runtime)) (define ffi-lstat-mode (lambda (path) (ffi-lstat-mode-c path))) - (define ffi-stat-isdir - (lambda (path) (if (file-directory? path) 1 0))) (def (parse-octal-mode str) (string->number str 8)) (def (string-split-commas str) (let loop ([i 0] [start 0] [acc '()]) @@ -103,35 +101,37 @@ (parse-octal-mode str) (apply-symbolic-mode str current-mode))) (def (do-chmod path mode-str verbose changes-only recursive) - (let* ([cur-mode (ffi-lstat-mode path)]) + (let ([ftype (ffi-lstat-type path)]) (cond - [(< cur-mode 0) + [(< ftype 0) (warn "cannot access '~a': No such file or directory" path)] + [(and recursive (= ftype 2)) (void)] [else - (let ([new-mode (parse-mode mode-str cur-mode)]) - (if (not new-mode) - (warn "invalid mode: '~a'" mode-str) - (begin - (audit-file-modify! path) - (let ([rc (ffi-chmod path new-mode)]) - (cond - [(< rc 0) (warn "cannot chmod '~a'" path)] - [verbose - (when (or (not changes-only) - (not (= cur-mode new-mode))) - (displayln "mode of '" path "' changed from " - (number->string cur-mode 8) " to " - (number->string new-mode 8)))])))))])) - (when (and recursive (= (ffi-stat-isdir path) 1)) - (with-catch - (lambda (e) (warn "cannot open directory '~a'" path)) - (lambda () - (let ([files (directory-list path)]) - (for-each - (lambda (name) - (do-chmod (string-append path "/" name) mode-str verbose - changes-only recursive)) - files)))))) + (let ([cur-mode (ffi-lstat-mode path)]) + (let ([new-mode (parse-mode mode-str cur-mode)]) + (if (not new-mode) + (warn "invalid mode: '~a'" mode-str) + (begin + (audit-file-modify! path) + (let ([rc (ffi-chmod path new-mode)]) + (cond + [(< rc 0) (warn "cannot chmod '~a'" path)] + [verbose + (when (or (not changes-only) + (not (= cur-mode new-mode))) + (displayln "mode of '" path "' changed from " + (number->string cur-mode 8) " to " + (number->string new-mode 8)))]))))))]) + (when (and recursive (= ftype 1)) + (with-catch + (lambda (e) (warn "cannot open directory '~a'" path)) + (lambda () + (let ([files (directory-list path)]) + (for-each + (lambda (name) + (do-chmod (string-append path "/" name) mode-str + verbose changes-only recursive)) + files))))))) (def (main . args) (parameterize ([program-name "chmod"]) (init-security!) @@ -166,4 +166,9 @@ ffi-lstat-mode-c "coreutils_lstat_mode" (string) + int) + (define-coreutils-foreign + ffi-lstat-type + "coreutils_lstat_type" + (string) int)) --- a/lib/jerboa-coreutils/chown.sls +++ b/lib/jerboa-coreutils/chown.sls @@ -14,7 +14,6 @@ (jerboa-coreutils common security) (jerboa core) (jerboa runtime)) (define exit-status 0) - (def (ffi-stat-isdir path) (if (file-directory? path) 1 0)) (def (ffi-getpwnam-uid name) (with-catch (lambda (e) -1) @@ -64,8 +63,10 @@ [verbose (displayln "changed ownership of '" path "'")]))) (def (do-chown-recursive path uid gid no-deref verbose changes-only) - (let ([isdir (ffi-stat-isdir path)]) - (let ([rc ((if no-deref ffi-lchown ffi-chown) + (let ([ftype (ffi-lstat-type path)]) + (let ([rc ((if (or no-deref (= ftype 2)) + ffi-lchown + ffi-chown) path uid gid)]) @@ -74,7 +75,7 @@ (set! exit-status 1)) (when verbose (displayln "changed ownership of '" path "'"))) - (when (= isdir 1) + (when (= ftype 1) (with-catch (lambda (e) (warn "cannot open directory '~a'" path) @@ -141,4 +142,9 @@ ffi-getgrnam-gid-c "coreutils_getgrnam_gid" (string) + int) + (define-coreutils-foreign + ffi-lstat-type + "coreutils_lstat_type" + (string) int)) --- a/src/jerboa-coreutils/chgrp.ss +++ b/src/jerboa-coreutils/chgrp.ss @@ -16,15 +16,13 @@ (define-coreutils-foreign ffi-chgrp-chown "coreutils_chgrp_chown" (string int) int) (define-coreutils-foreign ffi-chgrp-lchown "coreutils_chgrp_lchown" (string int) int) (define-coreutils-foreign ffi-getgrnam-gid-c "coreutils_getgrnam_gid" (string) int) +(define-coreutils-foreign ffi-lstat-type "coreutils_lstat_type" (string) int) (def (ffi-getgrnam-gid name) (with-catch (lambda (e) -1) (lambda () (ffi-getgrnam-gid-c name)))) -(def (ffi-stat-isdir path) - (if (file-directory? path) 1 0)) - (def (resolve-group-id spec) (let ((n (string->number spec))) (if n @@ -41,18 +39,29 @@ (displayln "changed group of '" path "'"))))) (def (do-chgrp-recursive path gid no-deref verbose) - (do-chgrp path gid no-deref verbose) - (when (= (ffi-stat-isdir path) 1) - (with-catch - (lambda (e) - (warn "cannot open directory '~a'" path) - (set! exit-status 1)) - (lambda () - (let ((files (directory-list path))) - (for-each - (lambda (name) - (do-chgrp-recursive (string-append path "/" name) gid no-deref verbose)) - files)))))) + ;; coreutils_lstat_type uses lstat: -1=missing, 0=file/other, 1=directory, + ;; 2=symlink. A symlink to a directory is type 2, so it is never descended. + (let ((ftype (ffi-lstat-type path))) + ;; Affect symlinks themselves (lchown) so a link's target is never + ;; re-grouped during the walk; honour --no-dereference likewise. + (let ((rc ((if (or no-deref (= ftype 2)) ffi-chgrp-lchown ffi-chgrp-chown) path gid))) + (cond + ((< rc 0) + (warn "cannot chgrp '~a'" path) + (set! exit-status 1)) + (verbose + (displayln "changed group of '" path "'")))) + (when (= ftype 1) + (with-catch + (lambda (e) + (warn "cannot open directory '~a'" path) + (set! exit-status 1)) + (lambda () + (let ((files (directory-list path))) + (for-each + (lambda (name) + (do-chgrp-recursive (string-append path "/" name) gid no-deref verbose)) + files))))))) (def (main . args) (parameterize ((program-name "chgrp")) --- a/src/jerboa-coreutils/chmod.ss +++ b/src/jerboa-coreutils/chmod.ss @@ -19,10 +19,7 @@ (lambda (path) (ffi-lstat-mode-c path))) - -(define ffi-stat-isdir - (lambda (path) - (if (file-directory? path) 1 0))) +(define-coreutils-foreign ffi-lstat-type "coreutils_lstat_type" (string) int) ;; Parse octal mode string (def (parse-octal-mode str) @@ -114,36 +111,44 @@ (apply-symbolic-mode str current-mode))) (def (do-chmod path mode-str verbose changes-only recursive) - (let* ((cur-mode (ffi-lstat-mode path))) + ;; coreutils_lstat_type uses lstat: -1=missing, 0=file/other, 1=directory, + ;; 2=symlink. Recursion descends only real directories and skips symlinks, + ;; so a link to a directory is never followed into its target tree. + (let ((ftype (ffi-lstat-type path))) (cond - ((< cur-mode 0) + ((< ftype 0) (warn "cannot access '~a': No such file or directory" path)) + ;; chmod follows symlinks; skip them during recursion so the referenced + ;; file/directory is not re-moded. + ((and recursive (= ftype 2)) + (void)) (else - (let ((new-mode (parse-mode mode-str cur-mode))) - (if (not new-mode) - (warn "invalid mode: '~a'" mode-str) - (begin - (audit-file-modify! path) - (let ((rc (ffi-chmod path new-mode))) - (cond - ((< rc 0) - (warn "cannot chmod '~a'" path)) - (verbose - (when (or (not changes-only) (not (= cur-mode new-mode))) - (displayln "mode of '" path "' changed from " - (number->string cur-mode 8) " to " - (number->string new-mode 8)))))))))))) - ;; Recurse if directory - (when (and recursive (= (ffi-stat-isdir path) 1)) - (with-catch - (lambda (e) (warn "cannot open directory '~a'" path)) - (lambda () - (let ((files (directory-list path))) - (for-each - (lambda (name) - (do-chmod (string-append path "/" name) - mode-str verbose changes-only recursive)) - files)))))) + (let ((cur-mode (ffi-lstat-mode path))) + (let ((new-mode (parse-mode mode-str cur-mode))) + (if (not new-mode) + (warn "invalid mode: '~a'" mode-str) + (begin + (audit-file-modify! path) + (let ((rc (ffi-chmod path new-mode))) + (cond + ((< rc 0) + (warn "cannot chmod '~a'" path)) + (verbose + (when (or (not changes-only) (not (= cur-mode new-mode))) + (displayln "mode of '" path "' changed from " + (number->string cur-mode 8) " to " + (number->string new-mode 8)))))))))))) + ;; Recurse only into real directories (lstat type 1). + (when (and recursive (= ftype 1)) + (with-catch + (lambda (e) (warn "cannot open directory '~a'" path)) + (lambda () + (let ((files (directory-list path))) + (for-each + (lambda (name) + (do-chmod (string-append path "/" name) + mode-str verbose changes-only recursive)) + files))))))) (def (main . args) (parameterize ((program-name "chmod")) --- a/src/jerboa-coreutils/chown.ss +++ b/src/jerboa-coreutils/chown.ss @@ -17,9 +17,7 @@ (define-coreutils-foreign ffi-lchown "lchown" (string int int) int) (define-coreutils-foreign ffi-getpwnam-uid-c "coreutils_getpwnam_uid" (string) int) (define-coreutils-foreign ffi-getgrnam-gid-c "coreutils_getgrnam_gid" (string) int) - -(def (ffi-stat-isdir path) - (if (file-directory? path) 1 0)) +(define-coreutils-foreign ffi-lstat-type "coreutils_lstat_type" (string) int) (def (ffi-getpwnam-uid name) (with-catch @@ -74,14 +72,18 @@ (displayln "changed ownership of '" path "'"))))) (def (do-chown-recursive path uid gid no-deref verbose changes-only) - (let ((isdir (ffi-stat-isdir path))) - (let ((rc ((if no-deref ffi-lchown ffi-chown) path uid gid))) + ;; coreutils_lstat_type uses lstat: -1=missing, 0=file/other, 1=directory, + ;; 2=symlink. A symlink to a directory is type 2, so it is never descended. + (let ((ftype (ffi-lstat-type path))) + ;; Affect symlinks themselves (lchown) so a link's target is never + ;; re-owned during the walk; honour --no-dereference likewise. + (let ((rc ((if (or no-deref (= ftype 2)) ffi-lchown ffi-chown) path uid gid))) (when (< rc 0) (warn "cannot chown '~a'" path) (set! exit-status 1)) (when verbose (displayln "changed ownership of '" path "'"))) - (when (= isdir 1) + (when (= ftype 1) (with-catch (lambda (e) (warn "cannot open directory '~a'" path)