summaryrefslogtreecommitdiff
path: root/module/system/base/compile.scm
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2012-10-30 23:46:31 -0400
committerMark H Weaver <mhw@netris.org>2012-10-30 23:46:31 -0400
commitfa980bcc0f5b186b98d84fc5d165d35fcbb5d5ec (patch)
tree411ee841f7526fe7138e42cf399911518df06309 /module/system/base/compile.scm
parente088b09d7dce5d78c96288778969876b6d25d726 (diff)
parent10744b7c5007ccac19ea9654be6e749fe6a60992 (diff)
downloadguile-fa980bcc0f5b186b98d84fc5d165d35fcbb5d5ec.tar.gz
Merge remote-tracking branch 'origin/stable-2.0'
Moved scm_i_struct_hash from struct.c to hash.c and made it static. The port's alist is now a field of 'scm_t_port'. Conflicts: libguile/arrays.c libguile/hash.c libguile/ports.c libguile/print.h libguile/read.c
Diffstat (limited to 'module/system/base/compile.scm')
-rw-r--r--module/system/base/compile.scm19
1 files changed, 9 insertions, 10 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 0bc11a30f..afcb55a72 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -1,6 +1,6 @@
;;; 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
;;; 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
;; compilation).
;;
-(define (ensure-writable-dir dir)
+(define (ensure-directory dir)
(catch 'system-error
(lambda ()
(mkdir dir))
@@ -80,13 +80,12 @@
(let ((errno (and (pair? rest) (car rest))))
(cond
((eqv? errno EEXIST)
- (let ((st (stat dir)))
- (if (or (not (eq? (stat:type st) 'directory))
- (not (access? dir W_OK)))
- (error "directory not writable" dir))))
+ ;; Assume it's a writable directory, to avoid TOCTOU errors,
+ ;; as well as UID/EUID mismatches that occur with access(2).
+ #t)
((eqv? errno ENOENT)
- (ensure-writable-dir (dirname dir))
- (ensure-writable-dir dir))
+ (ensure-directory (dirname dir))
+ (ensure-directory dir))
(else
(throw k subr fmt args rest)))))))
@@ -125,7 +124,7 @@
%compile-fallback-path
(canonical->suffix (canonicalize-path file))
(compiled-extension))))
- (and (false-if-exception (ensure-writable-dir (dirname f)))
+ (and (false-if-exception (ensure-directory (dirname f)))
f))))
(define* (compile-file file #:key
@@ -144,7 +143,7 @@
;; Choose the input encoding deterministically.
(set-port-encoding! in (or enc "UTF-8"))
- (ensure-writable-dir (dirname comp))
+ (ensure-directory (dirname comp))
(call-with-output-file/atomic comp
(lambda (port)
((language-printer (ensure-language to))