Skip to content
Browse files

finished functions to search for executable files

  • Loading branch information...
1 parent ea23f5d commit 12bb742d340c0b4dd1e91d6b9bdc78534d1f02a0 @marcomaggi committed Apr 9, 2012
Showing with 154 additions and 43 deletions.
  1. +7 −0 ANNOUNCE
  2. +60 −0 doc/vicare.texi
  3. +55 −30 lib/vicare/posix.sls
  4. +32 −13 tests/test-vicare-posix.sps
View
7 ANNOUNCE
@@ -80,6 +80,13 @@ Notes for revision 0.2d10
split-pathname-bytevector
split-pathname-string
+* Added functions to (vicare posix):
+
+ find-executable-as-bytevector
+ find-executable-as-string
+ vicare-executable-as-bytevector
+ vicare-executable-as-string
+
Notes for revision 0.2d9
------------------------
View
60 doc/vicare.texi
@@ -7340,6 +7340,66 @@ Like @func{execve} but allows the environment to be given expliticly.
Like @func{execvp} but allows the arguments to be given expliticly.
@end defun
+
+@defun find-executable-as-bytevector @var{bv-pathname}
+@defunx find-executable-as-string @var{str-pathname}
+Given an absolute or relative file pathname or just the name of a file,
+search the file system for a matching executable file; when found return
+its absolute pathname as bytevector or Scheme string, else return
+@false{}. If an error occurs while inspecting the file system: raise an
+exception.
+
+@var{bv-pathname} must be a bytevector, @var{str-pathname} must be a
+string.
+
+@example
+#!vicare
+(import (vicare)
+ (prefix (vicare posix) px.))
+
+(px.find-executable-as-string "/usr/local/bin/vicare")
+@result{} "/usr/local/bin/vicare"
+
+(px.find-executable-as-string "vicare")
+@result{} "/usr/local/bin/vicare"
+
+(px.find-executable-as-string "this-cannot-exist")
+@result{} #f
+
+(px.find-executable-as-string "ls")
+@result{} "/usr/bin/ls"
+@end example
+@end defun
+
+
+@defun vicare-executable-as-bytevector
+@defunx vicare-executable-as-string
+Acquire the return value of @func{vicare-argv0} and search the file
+system for a matching executable file; when found return its absolute
+pathname as bytevector or Scheme string, else return @false{}. If an
+error occurs while inspecting the file system: raise an exception.
+
+Upon starting a @value{PRJNAME} process:
+
+@itemize
+@item
+If the executable @command{vicare} is specified as pathname relative to
+the current working directory: these functions will return the wrong
+absolute path when the current working directory is changed before a
+call to them.
+
+@item
+If the executable @command{vicare} is specified as file name with no
+directory part: these functions may return the wrong absolute path when
+the environment variable @env{PATH} is changed before a call to them.
+@end itemize
+
+For these reasons: these functions are both invoked upon loading the
+library @library{vicare posix} and they cache the result internally.
+Beware of neither change the current working directory nor change the
+@env{PATH} before loading @library{vicare posix}.
+@end defun
+
@c page
@node posix status
@section Process termination status.
View
85 lib/vicare/posix.sls
@@ -256,7 +256,8 @@
confstr confstr/string
;; executable pathname
- vicare-executable vicare-executable-string
+ find-executable-as-bytevector find-executable-as-string
+ vicare-executable-as-bytevector vicare-executable-as-string
;; miscellaneous functions
file-descriptor?)
@@ -3037,34 +3038,53 @@
;;;; executable pathname
-(module (vicare-executable vicare-executable-string)
-
- (define vicare-executable-string
- (case-lambda
- (()
- (let ((pathname (vicare-executable)))
- (and pathname (ascii->string pathname))))
- ((argv0)
- (define who 'vicare-executable-string)
- (with-arguments-validation (who)
- ((string argv0))
- (let ((pathname (vicare-executable (string->ascii argv0))))
- (and pathname (ascii->string pathname)))))))
-
- (define vicare-executable
- (case-lambda
- (()
- (vicare-executable (vicare-argv0)))
- ((argv0.bv)
- (define who 'vicare-executable)
- (with-arguments-validation (who)
- ((bytevector argv0.bv))
- (let ((argv0.len (unsafe.bytevector-length argv0.bv)))
- (if (%unsafe.first-char-is-slash? argv0.bv)
- argv0.bv
- (let* ((name (%unsafe.name-if-slash-char-found argv0.bv 0 argv0.len))
- (name (or name (%unsafe.path-search argv0.bv))))
- name)))))))
+(module (vicare-executable-as-bytevector
+ vicare-executable-as-string)
+
+ (define EXECUTABLE-BYTEVECTOR #f)
+ (define EXECUTABLE-STRING #f)
+
+ (define (vicare-executable-as-string)
+ (or EXECUTABLE-STRING
+ (begin
+ (set! EXECUTABLE-STRING (let ((pathname (vicare-executable-as-bytevector)))
+ (and pathname (ascii->string pathname))))
+ EXECUTABLE-STRING)))
+
+ (define (vicare-executable-as-bytevector)
+ (or EXECUTABLE-BYTEVECTOR
+ (begin
+ (set! EXECUTABLE-BYTEVECTOR (find-executable-as-bytevector (vicare-argv0)))
+ EXECUTABLE-BYTEVECTOR)))
+
+ #| end of module |# )
+
+(module (find-executable-as-bytevector
+ find-executable-as-string)
+
+ (define (find-executable-as-string pathname.str)
+ (define who 'find-executable-as-string)
+ (with-arguments-validation (who)
+ ((string pathname.str))
+ (let ((pathname.bv (find-executable-as-bytevector (string->ascii pathname.str))))
+ (and pathname.bv (ascii->string pathname.bv)))))
+
+ (define (find-executable-as-bytevector pathname.bv)
+ (define who 'find-executable-as-bytevector)
+ (with-arguments-validation (who)
+ ((bytevector pathname.bv))
+ (let* ((pathname.len (unsafe.bytevector-length pathname.bv))
+ (pathname.bv (if (%unsafe.first-char-is-slash? pathname.bv)
+ pathname.bv
+ (let ((name (%unsafe.name-if-slash-char-found pathname.bv 1 pathname.len)))
+ (if name
+ (bytevector-append (getcwd) SLASH-BV name)
+ (%unsafe.path-search pathname.bv))))))
+ (and pathname.bv
+ (file-exists? pathname.bv)
+ (access pathname.bv X_OK)
+ (file-is-regular-file? pathname.bv)
+ pathname.bv))))
(define-inline (%unsafe.first-char-is-slash? bv)
(unsafe.fx= ASCII-SLASH-FX (unsafe.bytevector-u8-ref bv 0)))
@@ -3094,7 +3114,7 @@
(let next-directory ((PATH-LIST PATH-LIST))
(if (null? PATH-LIST)
#f
- (let ((pathname (bytevector-append (car PATH-LIST) bv)))
+ (let ((pathname (bytevector-append (car PATH-LIST) SLASH-BV bv)))
(if (file-exists? pathname)
pathname
(next-directory (cdr PATH-LIST))))))))
@@ -3105,6 +3125,9 @@
(define-inline-constant ASCII-SLASH-FX
47 #;(char->integer #\/))
+ (define-inline-constant SLASH-BV
+ '#vu8(47))
+
#| end of module |# )
@@ -3131,6 +3154,8 @@
(set-rtd-printer! (type-descriptor struct-tm) %struct-tm-printer)
(set-rtd-printer! (type-descriptor struct-itimerval) %struct-itimerval-printer)
+(vicare-executable-as-string)
+
)
;;; end of file
View
45 tests/test-vicare-posix.sps
@@ -1257,15 +1257,15 @@
(check
(let ((rv (px.getnetbyaddr (bytevector-u32-ref '#vu8(127 0 0 0) 0 (endianness big))
AF_INET)))
- (check-pretty-print rv)
+;;; (check-pretty-print rv)
(px.struct-netent? rv))
=> #t)
(check
(for-all px.struct-netent? (px.network-entries))
=> #t)
- (check-pretty-print (px.network-entries))
+;;; (check-pretty-print (px.network-entries))
#f)
@@ -1782,22 +1782,25 @@
(parametrise ((check-test-name 'time))
- (check-pretty-print (list 'clock (px.clock)))
- (check-pretty-print (list 'time (px.time)))
- (check-pretty-print (list 'timeofday (px.gettimeofday)))
+ (when #f
+ (check-pretty-print (list 'clock (px.clock)))
+ (check-pretty-print (list 'time (px.time)))
+ (check-pretty-print (list 'timeofday (px.gettimeofday))))
;;; --------------------------------------------------------------------
(check
(px.struct-tms? (px.times))
=> #t)
- (check-pretty-print (px.times))
+ (when #f
+ (check-pretty-print (px.times)))
;;; --------------------------------------------------------------------
- (check-pretty-print (px.localtime (px.time)))
- (check-pretty-print (px.gmtime (px.time)))
+ (when #f
+ (check-pretty-print (px.localtime (px.time)))
+ (check-pretty-print (px.gmtime (px.time))))
(check
(let ((T (px.time)))
@@ -1809,8 +1812,9 @@
(equal? T (px.timegm (px.gmtime T))))
=> #t)
- (check-pretty-print
- (list 'strftime (px.strftime/string "%a %h %d %H:%M:%S %Y" (px.localtime (px.time)))))
+ (when #f
+ (check-pretty-print
+ (list 'strftime (px.strftime/string "%a %h %d %H:%M:%S %Y" (px.localtime (px.time))))))
;;; --------------------------------------------------------------------
@@ -2001,14 +2005,29 @@
#t)
-(parametrise ((check-test-name 'executable))
+(parametrise ((check-test-name 'find-executable))
(check ;first char is slash
- (px.vicare-executable-string "/usr/local/bin/vicare")
+ (px.find-executable-as-string "/usr/local/bin/vicare")
=> "/usr/local/bin/vicare")
- (check-pretty-print (px.vicare-executable-string "vicare"))
+ (check
+ (px.find-executable-as-string "vicare")
+ => "/usr/local/bin/vicare")
+ (check
+ (px.find-executable-as-string "this-cannot-exist")
+ => #f)
+
+ (check
+ (px.find-executable-as-string "ls")
+ => "/usr/bin/ls")
+
+ (when #f
+ (fprintf (current-error-port)
+ "vicare executable ~a\n" (px.find-executable-as-string "vicare"))
+ (fprintf (current-error-port)
+ "vicare-executable-string => ~a\n" (px.vicare-executable-as-string)))
#t)

0 comments on commit 12bb742

Please sign in to comment.
Something went wrong with that request. Please try again.