mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

Don't stat(2) and access(2) the .go location before using it.

Browse source 
* module/system/base/compile.scm (ensure-directory): Rename to...
  (ensure-directory): ... this.  Update callers.  When ERRNO is EEXIST,
  assume DIR is a writable directory instead of calling `stat' and
  `access?' again.  Fixes UID/EUID mismatches for setuid binaries.
  Reported by rixed@happyleptic.org at
  <http://lists.gnu.org/archive/html/guile-user/2012-06/msg00023.html>.
This commit is contained in:
Ludovic Courtès 2012-09-11 23:44:59 +02:00
parent e7350baf1e
commit b6aedd68bc
1 changed files with 9 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

19
module/system/base/compile.scm
View file

@ -1,6 +1,6 @@
;;; High-level compiler interface ;;; High-level compiler interface
;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;; This library is free software; you can redistribute it and/or ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; modify it under the terms of the GNU Lesser General Public
@ -72,7 +72,7 @@
;; before the check, so that we avoid races (possibly due to parallel ;; before the check, so that we avoid races (possibly due to parallel
;; compilation). ;; compilation).
;; ;;
(define (ensure-writable-dir dir) (define (ensure-directory dir)
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(mkdir dir)) (mkdir dir))
@ -80,13 +80,12 @@
(let ((errno (and (pair? rest) (car rest)))) (let ((errno (and (pair? rest) (car rest))))
(cond (cond
((eqv? errno EEXIST) ((eqv? errno EEXIST)
(let ((st (stat dir))) ;; Assume it's a writable directory, to avoid TOCTOU errors,
(if (or (not (eq? (stat:type st) 'directory)) ;; as well as UID/EUID mismatches that occur with access(2).
(not (access? dir W_OK))) #t)
(error "directory not writable" dir))))
((eqv? errno ENOENT) ((eqv? errno ENOENT)
(ensure-writable-dir (dirname dir)) (ensure-directory (dirname dir))
(ensure-writable-dir dir)) (ensure-directory dir))
(else (else
(throw k subr fmt args rest))))))) (throw k subr fmt args rest)))))))
@ -125,7 +124,7 @@
%compile-fallback-path %compile-fallback-path
(canonical->suffix (canonicalize-path file)) (canonical->suffix (canonicalize-path file))
(compiled-extension)))) (compiled-extension))))
(and (false-if-exception (ensure-writable-dir (dirname f))) (and (false-if-exception (ensure-directory (dirname f)))
f)))) f))))
(define* (compile-file file #:key (define* (compile-file file #:key
@ -144,7 +143,7 @@
;; Choose the input encoding deterministically. ;; Choose the input encoding deterministically.
(set-port-encoding! in (or enc "UTF-8")) (set-port-encoding! in (or enc "UTF-8"))
(ensure-writable-dir (dirname comp)) (ensure-directory (dirname comp))
(call-with-output-file/atomic comp (call-with-output-file/atomic comp
(lambda (port) (lambda (port)
((language-printer (ensure-language to)) ((language-printer (ensure-language to))