From a19a0340aa5a935201916d3c0612e796522a3797 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Mon, 4 Apr 2011 15:14:20 -0600 Subject: [PATCH] added ffi/unsafe/security --- collects/ffi/unsafe/security.rkt | 145 ++++++++++++++++++++ collects/scribblings/foreign/derived.scrbl | 1 + collects/scribblings/foreign/security.scrbl | 42 ++++++ 3 files changed, 188 insertions(+) create mode 100644 collects/ffi/unsafe/security.rkt create mode 100644 collects/scribblings/foreign/security.scrbl diff --git a/collects/ffi/unsafe/security.rkt b/collects/ffi/unsafe/security.rkt new file mode 100644 index 0000000000..34a0f4654e --- /dev/null +++ b/collects/ffi/unsafe/security.rkt @@ -0,0 +1,145 @@ +#lang racket/base +(require ffi/unsafe) +(provide security-guard-check-file + _file/guard + _file/r + _file/rw) + +(define SCHEME_GUARD_FILE_READ #x1) +(define SCHEME_GUARD_FILE_WRITE #x2) +(define SCHEME_GUARD_FILE_EXECUTE #x4) +(define SCHEME_GUARD_FILE_DELETE #x8) +(define SCHEME_GUARD_FILE_EXISTS #x10) + +(define scheme_security_check_file + (get-ffi-obj "scheme_security_check_file" (ffi-lib #f) + (_fun _symbol _path _int -> _void))) + +(define (convert-modes who guards) + (unless (list? guards) + (raise-type-error who "list of symbols" guards)) + (let ([read? 0] + [write? 0] + [execute? 0] + [delete? 0] + [exists? 0]) + (for-each (lambda (guard) + (case guard + ((read) (set! read? SCHEME_GUARD_FILE_READ)) + ((write) (set! write? SCHEME_GUARD_FILE_WRITE)) + ((execute) (set! execute? SCHEME_GUARD_FILE_EXECUTE)) + ((delete) (set! delete? SCHEME_GUARD_FILE_DELETE)) + ((exists) (set! exists? SCHEME_GUARD_FILE_EXISTS)) + (else (error who "bad permission symbol: ~e" guard)))) + guards) + (when (and (positive? exists?) + (positive? (+ read? write? execute? delete?))) + (error who "permission 'exists must occur alone: ~e" guards)) + (+ read? write? execute? delete? exists?))) + +(define (security-guard-check-file who path modes) + (unless (symbol? who) + (raise-type-error 'security-guard-check-file "symbol" 0 who path modes)) + (unless (or (path? path) (path-string? path)) + (raise-type-error 'security-guard-check-file "path or path string" 1 who path modes)) + (let ([cp (cleanse-path (path->complete-path path))] + [mode (convert-modes 'security-guard-check-file modes)]) + (scheme_security_check_file who cp mode))) + +(define (_file/guard modes [who '_file/guard]) + (let ([mode (convert-modes '_file/guard modes)]) + (unless (symbol? who) + (raise-type-error '_file/guard "symbol" who)) + (make-ctype + _path + (lambda (p) + (let ([cp (cleanse-path (path->complete-path p))]) + (scheme_security_check_file who cp mode) + cp)) + #f))) + +(define _file/r (_file/guard '(read) '_file/r)) +(define _file/rw (_file/guard '(read write) '_file/rw)) + +#| +;; -- Tests -- + +(require rackunit + racket/runtime-path) + +(define-runtime-module-path pub-mod0 racket/list) +(define-runtime-module-path priv-mod0 racket/private/stx) + +(define pub-mod (resolved-module-path-name pub-mod0)) +(define priv-mod (resolved-module-path-name priv-mod0)) + +(define (mk-fun modes) + ;; receives path pointer, casts as int, who cares + (get-ffi-obj "scheme_make_integer_value" (ffi-lib #f) + (_fun (path) :: + (path : (_file/guard modes)) + -> _scheme))) + +(define (fun path modes) + ((mk-fun modes) path)) + +(define sg0 (current-security-guard)) + +(define sg-ro + (make-security-guard + sg0 + (lambda (who path modes) + (when (or (memq 'write modes) (memq 'delete modes)) + (error who "write/delete not allowed"))) + void void)) + +(define sg-priv + (make-security-guard + sg0 + (lambda (who path modes) + (when (and path (regexp-match #rx"private" (path->string path))) + (error who "no access to private paths: ~e" path))) + void void)) + +;; Test works on both strings and paths, rel and abs. + +(define-syntax-rule (check-ok expr) (check-not-exn (lambda () expr))) +(define-syntax-rule (check-err expr) (check-exn exn:fail? (lambda () expr))) + +(define-syntax-rule (run1 expr ok?) + (void + (if ok? + (check-not-exn (lambda () expr)) + (check-exn exn:fail? (lambda () expr))))) + +(define (run path modes ok?) + (run1 (security-guard-check-file 'me path modes) ok?) + (run1 (fun path modes) ok?)) + +(test-case "default security guard" + (parameterize ((current-security-guard sg0)) + (run "foo.txt" '(read) #t) + (run "bar.txt" '(write delete) #t) + (run pub-mod '(read) #t) + (run pub-mod '(write) #t) + (run priv-mod '(read) #t) + (run priv-mod '(read write delete) #t))) + +(test-case "read-only security-guard" + (parameterize ((current-security-guard sg-ro)) + (run "foo.txt" '(read) #t) + (run "bar.txt" '(write delete) #f) + (run pub-mod '(read) #t) + (run pub-mod '(write) #f) + (run priv-mod '(read) #t) + (run priv-mod '(read write delete) #f))) + +(test-case "private security-guard" + (parameterize ((current-security-guard sg-priv)) + (run pub-mod '(read) #t) + (run pub-mod '(write) #t) + (run priv-mod '(read) #f) + (run priv-mod '(read write delete) #f))) + +(provide (all-defined-out)) +|# diff --git a/collects/scribblings/foreign/derived.scrbl b/collects/scribblings/foreign/derived.scrbl index 6525cec778..736ba32f5d 100644 --- a/collects/scribblings/foreign/derived.scrbl +++ b/collects/scribblings/foreign/derived.scrbl @@ -13,3 +13,4 @@ @include-section["atomic.scrbl"] @include-section["try-atomic.scrbl"] @include-section["objc.scrbl"] +@include-section["security.scrbl"] diff --git a/collects/scribblings/foreign/security.scrbl b/collects/scribblings/foreign/security.scrbl new file mode 100644 index 0000000000..b5a8e7b2fb --- /dev/null +++ b/collects/scribblings/foreign/security.scrbl @@ -0,0 +1,42 @@ +#lang scribble/doc +@(require "utils.ss" + (for-label ffi/unsafe/security)) + +@title[#:tag "security-guard-checks"]{Security-Guard Checks} + +@defmodule[ffi/unsafe/security] + +@defproc[(security-guard-check-file + [who symbol?] + [path path-string?] + [perms (listof (or/c 'read 'write 'execute 'delete 'exists))]) + void?]{ + +Checks whether @racket[(current-security-guard)] permits access to the +file specified by @racket[path] with the permissions +@racket[perms]. See @racket[make-security-guard] for more information +on @racket[perms]. + +The symbol @racket[who] should be the name of the function on whose +behalf the security check is performed; it is passed to the security +guard to use in access-denied errors. +} + +@defproc[(_file/guard [perms (listof (or/c 'read 'write 'execute 'delete 'exists))] + [who symbol? '_file/guard]) + ctype?]{ + +Like @racket[_file] and @racket[_path], but conversion from Racket to +C first completes the path using @racket[path->complete-path] then +cleanses it using @racket[cleanse-path], then checks that the current +security guard grants access on the resulting complete path with +@racket[perms]. As an output value, identical to @racket[_path]. +} + +@deftogether[[ +@defthing[_file/r ctype?] +@defthing[_file/rw ctype?]]]{ + +Equivalent to @racket[(_file/guard '(read))] and @racket[(_file/guard +'(read write))], respectively. +}