Permalink
Browse files

Implement hook to check for valid file-system accesses (this was moti…

…vated by a need for the Gambit REPL iOS app to respect clause 2.6 of the Apple developer agreement)
  • Loading branch information...
1 parent 53a9aa9 commit 29b53bf0676a853ecf15d616ac748e966c64a27a @feeley feeley committed Aug 8, 2011
Showing with 137 additions and 102 deletions.
  1. +1 −1 configure
  2. +1 −1 examples/iOS/build-gambit-iOS
  3. +1 −1 examples/iOS/makefile.in
  4. +20 −10 examples/iOS/program.scm
  5. +15 −15 lib/_eval.scm
  6. +10 −10 lib/_io.scm
  7. +2 −2 lib/_kernel.scm
  8. +66 −44 lib/_nonstd.scm
  9. +2 −2 lib/_thread.scm
  10. +3 −3 lib/os.c
  11. +4 −2 lib/os.h
  12. +2 −2 lib/os_base.c
  13. +2 −2 lib/os_base.h
  14. +2 −2 lib/os_files.c
  15. +2 −2 lib/os_io.c
  16. +4 −3 lib/os_tty.c
View
@@ -26755,7 +26755,7 @@ do
cat >>$CONFIG_STATUS <<_ACEOF
# First, check the format of the line:
cat >"\$tmp/defines.sed" <<\\CEOF
-/^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*/b def
+/^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def
/^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def
b
:def
@@ -1,6 +1,6 @@
#!/bin/sh
-### File: "build-gambit-iOS", Time-stamp: <2011-04-26 16:56:59 feeley>
+### File: "build-gambit-iOS"
### Copyright (c) 2010-2011 by Marc Feeley, All Rights Reserved.
@@ -120,7 +120,7 @@ prepare-for-xcode: json.m url.m html.m wiki.m program.m program_.m GambitREPL.xc
@echo "*************************************************************"
.scm.m:
- @SETDLPATH@ $(rootfromhere)/gsc/gsc -:~~bin=$(srcdirpfx)$(rootfromhere)/bin,~~lib=$(srcdirpfx)$(rootfromhere)/lib,~~include=$(srcdirpfx)$(rootfromhere)/include -f -c -check -debug -o $*.m $(srcdirpfx)$*.scm
+ @SETDLPATH@ $(rootfromhere)/gsc/gsc -:~~bin=$(srcdirpfx)$(rootfromhere)/bin,~~lib=$(srcdirpfx)$(rootfromhere)/lib,~~include=$(srcdirpfx)$(rootfromhere)/include -f -c -check -o $*.m $(srcdirpfx)$*.scm
program_.m: json.m url.m html.m wiki.m program.m
@SETDLPATH@ $(rootfromhere)/gsc/gsc -:~~bin=$(srcdirpfx)$(rootfromhere)/bin,~~lib=$(srcdirpfx)$(rootfromhere)/lib,~~include=$(srcdirpfx)$(rootfromhere)/include -f -link -o $@ $^
@@ -91,12 +91,30 @@
;;;----------------------------------------------------------------------------
+;; Make it impossible to access files outside of Gambit REPL. This is
+;; needed to respect clause 2.6 of the App Store Review Guidelines:
+;; "Apps that read or write data outside its designated container area
+;; will be rejected".
+
+(define (contained-path-resolve path)
+ (let loop ()
+ (let ((str (##path-expand path)))
+ (if (has-prefix? (##path-normalize str) app-dir)
+ str ;; only allow files in app directory
+ (begin
+ (error "App container violation")
+ (loop))))))
+
+(set! ##path-resolve-hook contained-path-resolve)
+
;; Make the current-directory and the "~~" path equal to the program's
;; .app directory.
-(define app-dir (path-directory (car (command-line))))
+(define app-dir
+ (##path-normalize (path-directory (car (command-line)))))
-(set! ##os-path-gambcdir (lambda () app-dir))
+(set! ##os-path-gambcdir
+ (lambda () app-dir))
(current-directory app-dir)
@@ -1128,14 +1146,6 @@ EOF
EOF
)
-("play-funny-sound" .
-#<<EOF
-;; Play funny sound.
-
-(AudioServicesPlaySystemSound 1010)
-EOF
-)
-
("F10" .
#<<EOF
;; Show date for a few seconds.
View
@@ -1,8 +1,8 @@
;;;============================================================================
-;;; File: "_eval.scm", Time-stamp: <2009-10-29 10:40:27 feeley>
+;;; File: "_eval.scm"
-;;; Copyright (c) 1994-2009 by Marc Feeley, All Rights Reserved.
+;;; Copyright (c) 1994-2011 by Marc Feeley, All Rights Reserved.
;;;============================================================================
@@ -3862,33 +3862,33 @@
abs-path)))))
(define (load-no-ext psettings path)
- (let* ((src-path (##path-expand path))
+ (let* ((src-path (##path-resolve path))
(result (load-source psettings src-path)))
(if (##not (##fixnum? result))
result
(let loop1 ((version 1)
(last-obj-file-path #f)
(last-obj-file-info #f))
- (let* ((expanded-path
- (##path-expand
+ (let* ((resolved-path
+ (##path-resolve
(##string-append path
".o"
(##number->string version 10))))
- (expanded-info
- (##file-info expanded-path))
- (expanded-path-exists?
- (##not (##fixnum? expanded-info))))
- (if expanded-path-exists?
+ (resolved-info
+ (##file-info resolved-path))
+ (resolved-path-exists?
+ (##not (##fixnum? resolved-info))))
+ (if resolved-path-exists?
(loop1 (##fixnum.+ version 1)
- expanded-path
- expanded-info)
+ resolved-path
+ resolved-info)
(if (and last-obj-file-path
(##not ##load-source-if-more-recent))
(load-binary last-obj-file-path)
(let loop2 ((lst ##scheme-file-extensions))
(if (##pair? lst)
(let* ((src-file-path
- (##path-expand
+ (##path-resolve
(##string-append path (##caar lst))))
(src-file-info
(if (##string? src-file-path)
@@ -3945,8 +3945,8 @@
(cond ((##string=? ext "")
(load-no-ext psettings path))
((binary-extension? ext)
- (let ((expanded-path (##path-expand path)))
- (load-binary expanded-path)))
+ (let ((resolved-path (##path-resolve path)))
+ (load-binary resolved-path)))
(else
(raise-os-exception-if-needed
(load-source psettings path))))))))))
View
@@ -5763,9 +5763,9 @@
(macro-psettings-arguments psettings)))
(environment
(macro-psettings-environment psettings))
- (expanded-directory
+ (resolved-directory
(if directory
- (##path-expand directory)
+ (##path-resolve directory)
(##current-directory)))
(direction
(macro-psettings-direction psettings)))
@@ -5779,7 +5779,7 @@
(##os-device-stream-open-process
path-and-arguments
environment
- expanded-directory
+ resolved-directory
(psettings->options psettings))))
(cond ((##fixnum? device)
(if raise-os-exception?
@@ -7076,11 +7076,11 @@
(##current-directory))))
(if (##not (##string? path))
(fail)
- (let* ((expanded-path
- (##path-expand path))
+ (let* ((resolved-path
+ (##path-resolve path))
(rdevice
(##os-device-directory-open-path
- expanded-path
+ resolved-path
(macro-psettings-ignore-hidden psettings))))
(if (##fixnum? rdevice)
(if raise-os-exception?
@@ -7376,11 +7376,11 @@
(arg2 (macro-absent-obj)))
(let* ((path
(macro-psettings-path psettings))
- (expanded-path
- (##path-expand path))
+ (resolved-path
+ (##path-resolve path))
(device
(##os-device-stream-open-path
- expanded-path
+ resolved-path
(##psettings->device-flags psettings)
(##psettings->permissions psettings #o666))))
(if (##fixnum? device)
@@ -7389,7 +7389,7 @@
(cont device))
(cont
(##make-device-port-from-single-device
- expanded-path
+ resolved-path
device
psettings)))))
View
@@ -1,8 +1,8 @@
;;;============================================================================
-;;; File: "_kernel.scm", Time-stamp: <2011-03-20 21:10:21 feeley>
+;;; File: "_kernel.scm"
-;;; Copyright (c) 1994-2010 by Marc Feeley, All Rights Reserved.
+;;; Copyright (c) 1994-2011 by Marc Feeley, All Rights Reserved.
;;;============================================================================
Oops, something went wrong.

0 comments on commit 29b53bf

Please sign in to comment.