[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Chicken-hackers] [PATCH 3/4] Remove ##sys#expand-home-path.
|
From: |
Florian Zumbiehl |
|
Subject: |
Re: [Chicken-hackers] [PATCH 3/4] Remove ##sys#expand-home-path. |
|
Date: |
Fri, 15 Mar 2013 07:58:02 +0100 |
|
User-agent: |
Mutt/1.5.20 (2009-06-14) |
Remove ##sys#expand-home-path as shell expansion has no place in a filesystem
API.
---
New version of the patch, the previous version was broken.
eval.scm | 2 -
files.scm | 14 +++----
library.scm | 123 +++++++++++++++++-------------------------------------
posix-common.scm | 35 +++++++--------
posixunix.scm | 45 ++++++++++----------
posixwin.scm | 12 +++---
6 files changed, 89 insertions(+), 142 deletions(-)
diff --git a/eval.scm b/eval.scm
index b56514b..156067a 100644
--- a/eval.scm
+++ b/eval.scm
@@ -937,8 +937,6 @@
(##sys#signal-hook #:type-error 'load "bad argument type - not a port or
string" x) )
(set! ##sys#load
(lambda (input evaluator pf #!optional timer printer)
- (when (string? input)
- (set! input (##sys#expand-home-path input)) )
(let* ((fname
(cond [(port? input) #f]
[(not (string? input)) (badfile input)]
diff --git a/files.scm b/files.scm
index 7398350..6bbd6f6 100644
--- a/files.scm
+++ b/files.scm
@@ -383,14 +383,12 @@ EOF
(display p out) )
(cdr parts))
(when (fx= i prev) (##sys#write-char-0 sep out))
- (let* ((r1 (get-output-string out))
- (r (##sys#expand-home-path r1)))
- (when (string=? r1 r)
- (when abspath
- (set! r (##sys#string-append (string sep) r)))
- (when drive
- (set! r (##sys#string-append drive r))))
- r))))
+ (let ((r (get-output-string out)))
+ (when abspath
+ (set! r (##sys#string-append (string sep) r)))
+ (when drive
+ (set! r (##sys#string-append drive r)))
+ r))))
((*char-pds? (string-ref path i))
(when (and (null? parts) (fx= i prev))
(set! abspath #t))
diff --git a/library.scm b/library.scm
index 76c2384..bfe6447 100644
--- a/library.scm
+++ b/library.scm
@@ -1928,30 +1928,6 @@ EOF
name) )
name) ) ) )
-(define (##sys#pathname-resolution name thunk . _)
- (thunk (##sys#expand-home-path name)) )
-
-(define ##sys#expand-home-path
- (lambda (path)
- (let ((len (##sys#size path)))
- (if (fx> len 0)
- (case (##core#inline "C_subchar" path 0)
- ((#\~)
- (let ((rest (##sys#substring path 1 len)))
- (##sys#string-append (or (get-environment-variable "HOME") "")
rest) ) )
- ((#\$)
- (let loop ((i 1))
- (if (fx>= i len)
- path
- (let ((c (##core#inline "C_subchar" path i)))
- (if (or (eq? c #\/) (eq? c #\\))
- (##sys#string-append
- (or (get-environment-variable (##sys#substring path 1
i)) "")
- (##sys#substring path i len))
- (loop (fx+ i 1)) ) ) ) ) )
- (else path) )
- "") ) ) )
-
(define open-input-file)
(define open-output-file)
(define close-input-port)
@@ -1961,28 +1937,24 @@ EOF
(define (open name inp modes loc)
(##sys#check-string name loc)
- (##sys#pathname-resolution
- name
- (lambda (name)
- (let ([fmode (if inp "r" "w")]
- [bmode ""] )
- (do ([modes modes (##sys#slot modes 1)])
- ((null? modes))
- (let ([o (##sys#slot modes 0)])
- (case o
- [(#:binary) (set! bmode "b")]
- [(#:text) (set! bmode "")]
- [(#:append)
- (if inp
- (##sys#error loc "cannot use append mode with input file")
- (set! fmode "a") ) ]
- [else (##sys#error loc "invalid file option" o)] ) ) )
- (let ([port (##sys#make-port inp ##sys#stream-port-class name
'stream)])
- (unless (##sys#open-file-port port name (##sys#string-append fmode
bmode))
- (##sys#update-errno)
- (##sys#signal-hook #:file-error loc (##sys#string-append "cannot
open file - " strerror) name) )
- port) ) )
- #:open (not inp) modes) )
+ (let ([fmode (if inp "r" "w")]
+ [bmode ""] )
+ (do ([modes modes (##sys#slot modes 1)])
+ ((null? modes))
+ (let ([o (##sys#slot modes 0)])
+ (case o
+ [(#:binary) (set! bmode "b")]
+ [(#:text) (set! bmode "")]
+ [(#:append)
+ (if inp
+ (##sys#error loc "cannot use append mode with input file")
+ (set! fmode "a") ) ]
+ [else (##sys#error loc "invalid file option" o)] ) ) )
+ (let ([port (##sys#make-port inp ##sys#stream-port-class name 'stream)])
+ (unless (##sys#open-file-port port name (##sys#string-append fmode
bmode))
+ (##sys#update-errno)
+ (##sys#signal-hook #:file-error loc (##sys#string-append "cannot
open file - " strerror) name) )
+ port) ) )
(define (close port loc)
(##sys#check-port port loc)
@@ -2052,25 +2024,17 @@ EOF
(define (file-exists? name)
(##sys#check-string name 'file-exists?)
- (##sys#pathname-resolution
- name
- (lambda (name)
- (and (##sys#file-exists?
- (##sys#platform-fixup-pathname name)
- #f #f 'file-exists?)
- name) )
- #:exists?) )
+ (and (##sys#file-exists?
+ (##sys#platform-fixup-pathname name)
+ #f #f 'file-exists?)
+ name) )
(define (directory-exists? name)
(##sys#check-string name 'directory-exists?)
- (##sys#pathname-resolution
- name
- (lambda (name)
- (and (##sys#file-exists?
- (##sys#platform-fixup-pathname name)
- #f #t 'directory-exists?)
- name) )
- #:exists?) )
+ (and (##sys#file-exists?
+ (##sys#platform-fixup-pathname name)
+ #f #t 'directory-exists?)
+ name) )
(define (##sys#flush-output port)
((##sys#slot (##sys#slot port 2) 5) port) ; flush-output
@@ -2101,33 +2065,22 @@ EOF
(define (delete-file filename)
(##sys#check-string filename 'delete-file)
- (##sys#pathname-resolution
- filename
- (lambda (filename)
- (unless (eq? 0 (##core#inline "C_delete_file" (##sys#make-c-string
filename 'delete-file)))
- (##sys#update-errno)
- (##sys#signal-hook
- #:file-error 'delete-file
- (##sys#string-append "cannot delete file - " strerror) filename) )
- filename)
- #:delete) )
+ (unless (eq? 0 (##core#inline "C_delete_file" (##sys#make-c-string filename
'delete-file)))
+ (##sys#update-errno)
+ (##sys#signal-hook
+ #:file-error 'delete-file
+ (##sys#string-append "cannot delete file - " strerror) filename) )
+ filename)
(define (rename-file old new)
(##sys#check-string old 'rename-file)
(##sys#check-string new 'rename-file)
- (##sys#pathname-resolution
- old
- (lambda (old)
- (##sys#pathname-resolution
- new
- (lambda (new)
- (unless (eq? 0 (##core#inline "C_rename_file" (##sys#make-c-string old
'rename-file) (##sys#make-c-string new)))
- (##sys#update-errno)
- (##sys#signal-hook
- #:file-error 'rename-file
- (##sys#string-append "cannot rename file - " strerror) old new) )
- new)))
- #:rename new) )
+ (unless (eq? 0 (##core#inline "C_rename_file" (##sys#make-c-string old
'rename-file) (##sys#make-c-string new)))
+ (##sys#update-errno)
+ (##sys#signal-hook
+ #:file-error 'rename-file
+ (##sys#string-append "cannot rename file - " strerror) old new) )
+ new)
;;; Decorate procedure with arbitrary data
diff --git a/posix-common.scm b/posix-common.scm
index 1f7c4b3..3b8602e 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -160,7 +160,7 @@ EOF
((string? file)
(let ((path (##sys#make-c-string
(##sys#platform-fixup-pathname
- (##sys#expand-home-path file))
+ file)
loc)))
(if link
(##core#inline "C_lstat" path)
@@ -189,7 +189,7 @@ EOF
(lambda (f t)
(##sys#check-number t 'set-file-modification-time)
(let ((r ((foreign-lambda int "set_file_mtime" c-string scheme-object)
- (##sys#expand-home-path f) t)))
+ f t)))
(when (fx< r 0)
(posix-error
#:file-error 'set-file-modification-time
@@ -323,21 +323,20 @@ EOF
(unless (fx= 0 (##core#inline "C_rmdir" sname))
(posix-error #:file-error 'delete-directory "cannot delete directory"
dir) )))
(##sys#check-string name 'delete-directory)
- (let ((name (##sys#expand-home-path name)))
- (if recursive
- (let ((files (find-files ; relies on `find-files' to list
dir-contents before dir
- name
- dotfiles: #t
- follow-symlinks: #f)))
- (for-each
- (lambda (f)
- ((cond ((symbolic-link? f) delete-file)
- ((directory? f) rmdir)
- (else delete-file))
- f))
- files)
- (rmdir name))
- (rmdir name)))))
+ (if recursive
+ (let ((files (find-files ; relies on `find-files' to list dir-contents
before dir
+ name
+ dotfiles: #t
+ follow-symlinks: #f)))
+ (for-each
+ (lambda (f)
+ ((cond ((symbolic-link? f) delete-file)
+ ((directory? f) rmdir)
+ (else delete-file))
+ f))
+ files)
+ (rmdir name))
+ (rmdir name))))
(define directory
(lambda (#!optional (spec (current-directory)) show-dotfiles?)
@@ -347,7 +346,7 @@ EOF
[entry (##sys#make-pointer)] )
(##core#inline
"C_opendir"
- (##sys#make-c-string (##sys#expand-home-path spec) 'directory) handle)
+ (##sys#make-c-string spec 'directory) handle)
(if (##sys#null-pointer? handle)
(posix-error #:file-error 'directory "cannot open directory" spec)
(let loop ()
diff --git a/posixunix.scm b/posixunix.scm
index 8edd4ad..3d735e9 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -607,7 +607,7 @@ EOF
(##sys#check-string filename 'file-open)
(##sys#check-exact flags 'file-open)
(##sys#check-exact mode 'file-open)
- (let ([fd (##core#inline "C_open" (##sys#make-c-string
(##sys#expand-home-path filename) 'file-open) flags mode)])
+ (let ([fd (##core#inline "C_open" (##sys#make-c-string filename
'file-open) flags mode)])
(when (eq? -1 fd)
(posix-error #:file-error 'file-open "cannot open file" filename
flags mode) )
fd) ) ) ) )
@@ -764,22 +764,21 @@ EOF
(define create-directory
(lambda (name #!optional parents?)
(##sys#check-string name 'create-directory)
- (let ((name (##sys#expand-home-path name)))
- (unless (or (fx= 0 (##sys#size name))
- (file-exists? name))
- (if parents?
- (let loop ((dir (let-values (((dir file ext) (decompose-pathname
name)))
- (if file (make-pathname dir file ext) dir))))
- (when (and dir (not (directory? dir)))
- (loop (pathname-directory dir))
- (*create-directory 'create-directory dir)) )
- (*create-directory 'create-directory name) ) )
- name)))
+ (unless (or (fx= 0 (##sys#size name))
+ (file-exists? name))
+ (if parents?
+ (let loop ((dir (let-values (((dir file ext) (decompose-pathname
name)))
+ (if file (make-pathname dir file ext) dir))))
+ (when (and dir (not (directory? dir)))
+ (loop (pathname-directory dir))
+ (*create-directory 'create-directory dir)) )
+ (*create-directory 'create-directory name) ) )
+ name))
(define change-directory
(lambda (name)
(##sys#check-string name 'change-directory)
- (let ((sname (##sys#make-c-string (##sys#expand-home-path name)
'change-directory)))
+ (let ((sname (##sys#make-c-string name 'change-directory)))
(unless (fx= 0 (##core#inline "C_chdir" sname))
(posix-error #:file-error 'change-directory "cannot change current
directory" name) )
name)))
@@ -1194,7 +1193,7 @@ EOF
(lambda (fname m)
(##sys#check-string fname 'change-file-mode)
(##sys#check-exact m 'change-file-mode)
- (when (fx< (##core#inline "C_chmod" (##sys#make-c-string
(##sys#expand-home-path fname) 'change-file-mode) m) 0)
+ (when (fx< (##core#inline "C_chmod" (##sys#make-c-string fname
'change-file-mode) m) 0)
(posix-error #:file-error 'change-file-mode "cannot change file mode"
fname m) ) ) )
(define change-file-owner
@@ -1202,7 +1201,7 @@ EOF
(##sys#check-string fn 'change-file-owner)
(##sys#check-exact uid 'change-file-owner)
(##sys#check-exact gid 'change-file-owner)
- (when (fx< (##core#inline "C_chown" (##sys#make-c-string
(##sys#expand-home-path fn) 'change-file-owner) uid gid) 0)
+ (when (fx< (##core#inline "C_chown" (##sys#make-c-string fn
'change-file-owner) uid gid) 0)
(posix-error #:file-error 'change-file-owner "cannot change file owner"
fn uid gid) ) ) )
(define-foreign-variable _r_ok int "R_OK")
@@ -1212,7 +1211,7 @@ EOF
(let ()
(define (check filename acc loc)
(##sys#check-string filename loc)
- (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string
(##sys#expand-home-path filename) loc) acc))])
+ (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string
filename loc) acc))])
(unless r (##sys#update-errno))
r) )
(set! file-read-access? (lambda (filename) (check filename _r_ok
'file-read-access?)))
@@ -1252,8 +1251,8 @@ EOF
(##sys#check-string new 'create-symbolic-link)
(when (fx< (##core#inline
"C_symlink"
- (##sys#make-c-string (##sys#expand-home-path old)
'create-symbolic-link)
- (##sys#make-c-string (##sys#expand-home-path new)
'create-symbolic-link) )
+ (##sys#make-c-string old 'create-symbolic-link)
+ (##sys#make-c-string new 'create-symbolic-link) )
0)
(posix-error #:file-error 'create-symbol-link "cannot create symbolic
link" old new) ) ) )
@@ -1265,7 +1264,7 @@ EOF
(##sys#check-string fname 'read-symbolic-link)
(let ((len (##core#inline
"C_do_readlink"
- (##sys#make-c-string (##sys#expand-home-path fname)
'read-symbolic-link) buf)))
+ (##sys#make-c-string fname 'read-symbolic-link) buf)))
(if (fx< len 0)
(if canonicalize
fname
@@ -1478,7 +1477,7 @@ EOF
(define file-truncate
(lambda (fname off)
(##sys#check-number off 'file-truncate)
- (when (fx< (cond [(string? fname) (##core#inline "C_truncate"
(##sys#make-c-string (##sys#expand-home-path fname) 'file-truncate) off)]
+ (when (fx< (cond [(string? fname) (##core#inline "C_truncate"
(##sys#make-c-string fname 'file-truncate) off)]
[(fixnum? fname) (##core#inline "C_ftruncate" fname off)]
[else (##sys#error 'file-truncate "invalid file" fname)] )
0)
@@ -1537,7 +1536,7 @@ EOF
(##sys#check-string fname 'create-fifo)
(let ([mode (if (pair? mode) (car mode) (fxior _s_irwxu (fxior _s_irwxg
_s_irwxo)))])
(##sys#check-exact mode 'create-fifo)
- (when (fx< (##core#inline "C_mkfifo" (##sys#make-c-string
(##sys#expand-home-path fname) 'create-fifo) mode) 0)
+ (when (fx< (##core#inline "C_mkfifo" (##sys#make-c-string fname
'create-fifo) mode) 0)
(posix-error #:file-error 'create-fifo "cannot create FIFO" fname mode)
) ) ) )
(define fifo?
@@ -1545,7 +1544,7 @@ EOF
(##sys#check-string filename 'fifo?)
(case (##core#inline
"C_i_fifo_p"
- (##sys#make-c-string (##sys#expand-home-path filename) 'fifo?))
+ (##sys#make-c-string filename 'fifo?))
((#t) #t)
((#f) #f)
((0) (##sys#signal-hook #:file-error 'fifo? "file does not exist"
filename) )
@@ -1791,7 +1790,7 @@ EOF
(let ([s (car el)])
(##sys#check-string s 'process-execute)
(setenv i s (##sys#size s)) ) ) )
- (let* ([prg (##sys#make-c-string (##sys#expand-home-path filename)
'process-execute)]
+ (let* ([prg (##sys#make-c-string filename 'process-execute)]
[r (if envlist
(##core#inline "C_execve" prg)
(##core#inline "C_execvp" prg) )] )
diff --git a/posixwin.scm b/posixwin.scm
index 6b3ca4d..0346ef1 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -967,7 +967,7 @@ EOF
(##sys#check-string filename 'file-open)
(##sys#check-exact flags 'file-open)
(##sys#check-exact mode 'file-open)
- (let ([fd (##core#inline "C_open" (##sys#make-c-string
(##sys#expand-home-path filename) 'file-open) flags mode)])
+ (let ([fd (##core#inline "C_open" (##sys#make-c-string filename
'file-open) flags mode)])
(when (eq? -1 fd)
(##sys#update-errno)
(##sys#signal-hook #:file-error 'file-open "cannot open file"
filename flags mode) )
@@ -1100,7 +1100,7 @@ EOF
(define create-directory
(lambda (name #!optional parents?)
(##sys#check-string name 'create-directory)
- (let ((name (##sys#expand-home-path name)))
+ (let ((name name))
(if parents?
(create-directory-helper-parents name)
(create-directory-helper name))
@@ -1109,7 +1109,7 @@ EOF
(define change-directory
(lambda (name)
(##sys#check-string name 'change-directory)
- (let ((sname (##sys#make-c-string (##sys#expand-home-path name)
'change-directory)))
+ (let ((sname (##sys#make-c-string name 'change-directory)))
(unless (fx= 0 (##core#inline "C_chdir" sname))
(##sys#update-errno)
(##sys#signal-hook
@@ -1309,7 +1309,7 @@ EOF
(lambda (fname m)
(##sys#check-string fname 'change-file-mode)
(##sys#check-exact m 'change-file-mode)
- (when (fx< (##core#inline "C_chmod" (##sys#make-c-string
(##sys#expand-home-path fname) 'change-file-mode) m) 0)
+ (when (fx< (##core#inline "C_chmod" (##sys#make-c-string fname
'change-file-mode) m) 0)
(##sys#update-errno)
(##sys#signal-hook #:file-error 'change-file-mode "cannot change file
mode" fname m) ) ) )
@@ -1320,7 +1320,7 @@ EOF
(let ()
(define (check filename acc loc)
(##sys#check-string filename loc)
- (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string
(##sys#expand-home-path filename) loc) acc))])
+ (let ([r (fx= 0 (##core#inline "C_test_access" (##sys#make-c-string
filename loc) acc))])
(unless r (##sys#update-errno))
r) )
(set! file-read-access? (lambda (filename) (check filename _r_ok
'file-read-access?)))
@@ -1530,7 +1530,7 @@ EOF
(build-exec-argvec loc (and arglst ($quote-args-list arglst exactf))
setarg 1)
(build-exec-argvec loc envlst setenv 0)
(##core#inline "C_flushall")
- (##sys#make-c-string (##sys#expand-home-path filename) loc) ) ) )
+ (##sys#make-c-string filename loc) ) ) )
(define ($exec-teardown loc msg filename res)
(##sys#update-errno)
--
1.7.2.5
- [Chicken-hackers] [PATCH 2/4] csi: fix untrusted code execution by (load)ing ./.csirc, (continued)
- [Chicken-hackers] [PATCH 4/4] files split-directory: don't split on backslashes on non-windows, Florian Zumbiehl, 2013/03/15
- [Chicken-hackers] [PATCH 3/4] Remove ##sys#expand-home-path., Florian Zumbiehl, 2013/03/15
- Re: [Chicken-hackers] [PATCH 3/4] Remove ##sys#expand-home-path., Christian Kellermann, 2013/03/15
- Re: [Chicken-hackers] [PATCH 3/4] Remove ##sys#expand-home-path., Peter Bex, 2013/03/15
- Re: [Chicken-hackers] [PATCH 3/4] Remove ##sys#expand-home-path., Alaric Snell-Pym, 2013/03/15
- Re: [Chicken-hackers] [PATCH 3/4] Remove ##sys#expand-home-path., Felix, 2013/03/15
- Re: [Chicken-hackers] [PATCH 3/4] Remove ##sys#expand-home-path., Peter Bex, 2013/03/15