use OS X native SSL when libssl is too old

OS X's libssl is deprecated, and it doesn't work with SSL connections
that need SNI. We'll distribute out own libssl builds for OS X via a
package, but we need a native implementation that works well enough to
get that package.

pkgs/racket-doc/openssl/openssl.scrbl

@@ -29,8 +29,10 @@ or with the Racket distribution. In particular:
 included in the Racket distribution for Windows.}
 
 @item{For Mac OS X, @racketmodname[openssl] depends on
-@filepath{libssl.dylib} and @filepath{libcrypto.dylib}, which are
+@filepath{libssl.dylib} and @filepath{libcrypto.dylib}. Although those
-provided by Mac OS X 10.2 and later.}
+libraries are provided by Mac OS X 10.2 and later, their use is
+deprecated, so the Racket distribution for Mac OS X includes newer
+versions.}
 
 @item{For Unix, @racketmodname[openssl] depends on
 @filepath{libssl.so} and @filepath{libcrypto.so}, which must be

racket/collects/net/http-client.rkt

@@ -9,6 +9,7 @@
                     [tcp-abandon-port plain-tcp-abandon-port])
          openssl
          "win32-ssl.rkt"
+         "osx-ssl.rkt"
          file/gunzip)
 
 (define tolerant? #t)
@@ -65,6 +66,11 @@
     (cond [ssl?
            (set-http-conn-port-usual?! hc (= 443 port))
            (cond
+             [(osx-old-openssl?)
+              ;; OpenSSL is either not available or too old; use
+              ;; native OS X tools
+              (set-http-conn-abandon-p! hc osx-ssl-abandon-port)
+              (osx-ssl-connect host port ssl-version)]
              [(or ssl-available? (not win32-ssl-available?))
               (set-http-conn-abandon-p! hc ssl-abandon-port)
               (ssl-connect host port ssl-version)]

racket/collects/net/osx-ssl.rkt

@@ -0,0 +1,462 @@
+#lang racket/base
+(require ffi/unsafe
+         ffi/unsafe/define
+         ffi/unsafe/nsstring
+         ffi/unsafe/alloc
+         ffi/unsafe/atomic
+         ffi/unsafe/custodian
+         racket/port
+         racket/format
+         openssl)
+
+(provide osx-ssl-connect
+         osx-ssl-abandon-port
+         osx-ssl-output-port?
+         osx-old-openssl?)
+
+(define (osx-old-openssl?)
+  (and (eq? 'macosx (system-type))
+       (or (not ssl-available?)
+           (not (memq 'tls12 (supported-client-protocols))))))
+
+(define cf-lib
+  (and (eq? 'macosx (system-type))
+       (ffi-lib "/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation")))
+(define net-lib
+  (and (eq? 'macosx (system-type))
+       (ffi-lib "/System/Library/Frameworks/CFNetwork.framework/CFNetwork")))
+
+(define-ffi-definer define-cf cf-lib
+  #:default-make-fail make-not-available)
+(define-ffi-definer define-net net-lib
+  #:default-make-fail make-not-available)
+(define-ffi-definer define-racket #f
+  #:default-make-fail make-not-available)
+
+(define _CFReadStreamRef (_cpointer/null 'CFReadStreamRef))
+(define _CFWriteStreamRef (_cpointer/null 'CFWriteStreamRef))
+
+(define _CFRunLoopRef (_cpointer/null 'CFRunLoopRef))
+
+(define _CFDictionaryRef (_cpointer/null 'CFDictionaryRef))
+
+(define _Boolean _bool)
+(define _CFIndex _long)
+
+(define-cf CFRelease (_fun _pointer -> _void)
+  #:wrap (deallocator))
+
+(define retain
+  ((allocator CFRelease) (lambda (p) p)))
+
+;; Call in atomic mode to ensure `retain` calls:
+(define-cf CFStreamCreatePairWithSocketToHost
+  (_fun (_pointer = #f)
+        _NSString
+        _int32
+        (in : (_ptr o _CFReadStreamRef))
+        (out : (_ptr o _CFWriteStreamRef))
+        -> _void
+        -> (values (and in (retain in)) (and out (retain out)))))
+
+(define-cf CFReadStreamScheduleWithRunLoop (_fun _CFReadStreamRef _CFRunLoopRef _pointer -> _void))
+(define-cf CFWriteStreamScheduleWithRunLoop (_fun _CFWriteStreamRef _CFRunLoopRef _pointer -> _void))
+
+(define-cf CFReadStreamOpen (_fun _CFReadStreamRef -> _Boolean))
+(define-cf CFWriteStreamOpen (_fun _CFWriteStreamRef -> _Boolean))
+
+(define-cf CFReadStreamClose (_fun _CFReadStreamRef -> _void))
+(define-cf CFWriteStreamClose (_fun _CFWriteStreamRef -> _void))
+
+(define-cf CFReadStreamHasBytesAvailable (_fun _CFReadStreamRef -> _Boolean))
+(define-cf CFReadStreamRead (_fun _CFReadStreamRef _pointer _CFIndex -> _CFIndex))
+
+(define-cf CFWriteStreamCanAcceptBytes (_fun _CFWriteStreamRef -> _Boolean))
+(define-cf CFWriteStreamWrite (_fun _CFWriteStreamRef _pointer _CFIndex -> _CFIndex))
+
+(define-cf kCFRunLoopDefaultMode _pointer)
+
+(define-cf CFRunLoopStop (_fun _CFRunLoopRef -> _void))
+
+(define-cstruct _CFStreamError ([domain _int]
+                                [error _int32]))
+
+(define-cf CFReadStreamGetError (_fun _CFReadStreamRef -> _CFStreamError))
+(define-cf CFWriteStreamGetError (_fun _CFWriteStreamRef -> _CFStreamError))
+
+(define-cf NSStreamSocketSecurityLevelNegotiatedSSL _pointer)
+(define-cf NSStreamSocketSecurityLevelKey _pointer)
+
+(define-net kCFStreamPropertySSLSettings _pointer)
+(define-net kCFStreamSSLValidatesCertificateChain _pointer)
+(define-net kCFStreamSSLLevel _pointer)
+
+(define-cf kCFBooleanFalse _pointer)
+(define-cf kCFBooleanTrue _pointer)
+
+(define-net kCFStreamSocketSecurityLevelSSLv2 _pointer)
+(define-net kCFStreamSocketSecurityLevelSSLv3 _pointer)
+(define-net kCFStreamSocketSecurityLevelTLSv1 _pointer)
+(define-net kCFStreamSocketSecurityLevelNegotiatedSSL _pointer)
+
+(define-cf CFReadStreamSetProperty (_fun _CFReadStreamRef _pointer _pointer -> _Boolean))
+(define-cf CFWriteStreamSetProperty (_fun _CFWriteStreamRef _pointer _pointer -> _Boolean))
+
+(define-cstruct _CFStreamClientContext ([version _CFIndex]
+                                        [info _pointer]
+                                        [retain _pointer]
+                                        [release _pointer]
+                                        [copy _pointer]))
+
+(define-cf CFReadStreamSetClient (_fun _CFReadStreamRef
+                                       _int
+                                       (_fun #:atomic? #t
+                                             #:async-apply (lambda (f) (f))
+                                             _CFReadStreamRef _int _pointer -> _void)
+                                       _CFStreamClientContext-pointer
+                                       -> _Boolean))
+(define-cf CFWriteStreamSetClient (_fun _CFWriteStreamRef
+                                        _int
+                                        (_fun #:atomic? #t
+                                              #:async-apply (lambda (f) (f))
+                                              _CFWriteStreamRef _int _pointer -> _void)
+                                        _CFStreamClientContext-pointer
+                                        -> _Boolean))
+
+(define kCFStreamEventNone 0)
+(define kCFStreamEventOpenCompleted 1)
+(define kCFStreamEventHasBytesAvailable 2)
+(define kCFStreamEventCanAcceptBytes 4)
+(define kCFStreamEventErrorOccurred 8)
+(define kCFStreamEventEndEncountered 16)
+
+(define all-evts (bitwise-ior
+                  kCFStreamEventOpenCompleted
+                  kCFStreamEventHasBytesAvailable
+                  kCFStreamEventCanAcceptBytes
+                  kCFStreamEventErrorOccurred
+                  kCFStreamEventEndEncountered))
+
+(define _CFStreamStatus
+  (_enum '(kCFStreamStatusNotOpen
+           kCFStreamStatusOpening
+           kCFStreamStatusOpen
+           kCFStreamStatusReading
+           kCFStreamStatusWriting
+           kCFStreamStatusAtEnd
+           kCFStreamStatusClosed
+           kCFStreamStatusError)))
+
+(define-cf CFReadStreamGetStatus
+  (_fun _CFReadStreamRef -> _CFStreamStatus))
+(define-cf CFWriteStreamGetStatus
+  (_fun _CFWriteStreamRef -> _CFStreamStatus))
+
+
+(define-cf CFDictionaryCreate
+  (_fun (_pointer = #f)
+        (keys : (_list i _pointer))
+        (vals : (_list i _pointer))
+        (_CFIndex = (length keys))
+        (_pointer = #f)
+        (_pointer = #f)
+        -> _CFDictionaryRef)
+  #:wrap (allocator CFRelease))
+
+;; ----------------------------------------
+
+(define-cstruct _Scheme_Proc_Sequence ([num_procs _racket]
+                                       [data _pointer]
+                                       [proc1 _pointer]
+                                       [proc2 (_fun #:atomic? #t #:async-apply (lambda (f) (f)) _pointer -> _pointer)]
+                                       [proc3 _pointer]
+                                       [proc4 (_fun #:atomic? #t #:async-apply (lambda (f) (f)) -> _pointer)])
+  #:malloc-mode 'nonatomic)
+
+(define-racket scheme_signal_received (_fun -> _void))
+
+(define _pthread (_cpointer/null 'pthread))
+
+(define-racket pthread_create
+  (_fun (p : (_ptr o _pthread)) _pointer _pointer _pointer
+        -> (r : _int)
+        -> (and (zero? r)
+                p)))
+(define-racket pthread_detach
+  (_fun _pointer -> _int))
+
+(define-racket scheme_call_sequence_of_procedures-ptr _fpointer
+  #:c-id scheme_call_sequence_of_procedures)
+  
+(define-cf CFRunLoopRun-ptr _fpointer
+  #:c-id CFRunLoopRun)
+(define-cf CFRunLoopGetCurrent-ptr _fpointer
+  #:c-id CFRunLoopGetCurrent)
+
+(define stop-and-release
+  ((deallocator)
+   (lambda (run-loop)
+     (CFRunLoopStop run-loop)
+     (CFReleaseRunLoop run-loop))))
+
+(define-cf CFRetainRunLoop (_fun _CFRunLoopRef -> _CFRunLoopRef)
+  #:c-id CFRetain
+  #:wrap (allocator stop-and-release))
+(define-cf CFReleaseRunLoop (_fun _pointer -> _void)
+  #:c-id CFRelease)
+
+(define (launch-run-loop-in-pthread init-reg more-retain)
+  (define run-loop #f)
+  (define done (make-semaphore))
+  (define (setup r)
+    ;; Called in atomic mode in arbitrary Racket thread:
+    (set! run-loop (CFRetainRunLoop (cast r _pointer _CFRunLoopRef)))
+    (init-reg run-loop)
+    (semaphore-post done)
+    (scheme_signal_received)
+    #f)
+  (define (finished)
+    (free-immobile-cell retainer)
+    #f)
+  ;; Retains callbacks until the thread is done:
+  (define retainer (malloc-immobile-cell
+                    (vector setup finished more-retain)))
+  (define seq (make-Scheme_Proc_Sequence 4
+                                         #f
+                                         CFRunLoopGetCurrent-ptr
+                                         ;; `#:aync-apply` moves the following
+                                         ;; back to the main thread (in atomic mode):
+                                         setup
+                                         CFRunLoopRun-ptr
+                                         ;; `#:async-apply` here, too:
+                                         finished))
+  (define pth (pthread_create #f scheme_call_sequence_of_procedures-ptr seq))
+  (unless pth (error "could not start run-loop thread"))
+  (pthread_detach pth)
+  
+  (semaphore-wait done)
+  (set! done seq) ; retains `seq` until here
+
+  run-loop)
+
+;; ----------------------------------------
+
+(define (osx-ssl-connect host port [protocol 'auto])
+  (define-syntax-rule (check-ok (op arg ...))
+    (unless (op arg ...)
+      (error 'op "failed")))
+  
+  (define-values (in out)
+    (call-as-atomic
+     (lambda ()
+       (CFStreamCreatePairWithSocketToHost host port))))
+
+  (check-ok (CFReadStreamSetProperty in
+                                     NSStreamSocketSecurityLevelKey
+                                     NSStreamSocketSecurityLevelNegotiatedSSL))
+  (check-ok (CFWriteStreamSetProperty out
+                                      NSStreamSocketSecurityLevelKey
+                                      NSStreamSocketSecurityLevelNegotiatedSSL))
+  
+  (unless (eq? protocol 'secure)
+    (define d (CFDictionaryCreate
+               (list kCFStreamSSLValidatesCertificateChain
+                     kCFStreamSSLLevel)
+               (list kCFBooleanFalse
+                     (case protocol
+                       [(sslv2) kCFStreamSocketSecurityLevelSSLv2]
+                       [(sslv3) kCFStreamSocketSecurityLevelSSLv3]
+                       [(tls tls11 tls12) kCFStreamSocketSecurityLevelTLSv1]
+                       [else kCFStreamSocketSecurityLevelNegotiatedSSL]))))
+    (check-ok (CFReadStreamSetProperty in kCFStreamPropertySSLSettings d))
+    (check-ok (CFWriteStreamSetProperty out kCFStreamPropertySSLSettings d))
+    (CFRelease d))
+  
+  (define in-ready (make-semaphore))
+  (define out-ready (make-semaphore 1))
+  
+  ;; These callback must be retained so that they're not GCed
+  ;; until the run loop is terminated:
+  (define in-callback (lambda (_in evt _null)
+                        (void (semaphore-try-wait? in-ready))
+                        (semaphore-post in-ready)
+                        (scheme_signal_received)))
+  (define out-callback (lambda (_out evt _null)
+                         (void (semaphore-try-wait? out-ready))
+                         (semaphore-post out-ready)
+                         (scheme_signal_received)))
+
+  (define context (make-CFStreamClientContext 0 #f #f #f #f))
+  (check-ok (CFReadStreamSetClient in all-evts in-callback context))
+  (check-ok (CFWriteStreamSetClient out all-evts out-callback context))
+
+  (define run-loop
+    (launch-run-loop-in-pthread
+     ;; This function will be called as atomic within the scheduler:
+     (lambda (run-loop)
+       (CFReadStreamScheduleWithRunLoop in run-loop kCFRunLoopDefaultMode)
+       (CFWriteStreamScheduleWithRunLoop out run-loop kCFRunLoopDefaultMode))
+     (list in-callback out-callback)))
+  
+  (check-ok (CFWriteStreamOpen out))
+  (check-ok (CFReadStreamOpen in))
+  
+  (let loop ()
+    (when (or (eq? (CFReadStreamGetStatus in) 'kCFStreamStatusOpening)
+              (eq? (CFWriteStreamGetStatus out) 'kCFStreamStatusOpening))
+      (sync in-ready out-ready)
+      (loop)))
+  
+  (when (or (eq? (CFReadStreamGetStatus in) 'kCFStreamStatusError)
+            (eq? (CFWriteStreamGetStatus out) 'kCFStreamStatusError))
+    (raise
+     (exn:fail:network
+      (~a "osx-ssl-connect: connection failed\n"
+          "  address: " host "\n"
+          "  port number: " port)
+      (current-continuation-marks))))
+  
+  (define open-count 2)
+  (define skip-close-out? #f)
+  
+  (define in-cust-reg (register-custodian-shutdown in (lambda (v) (close!))))
+  (define out-cust-reg (register-custodian-shutdown out (lambda (v) (close!))))
+  
+  (define (close!)
+    (call-as-atomic
+     (lambda ()
+       (set! open-count (sub1 open-count))
+       (when (zero? open-count)
+         (unregister-custodian-shutdown in in-cust-reg)
+         (unregister-custodian-shutdown out out-cust-reg)
+         (stop-and-release run-loop)
+         (CFRelease in)
+         (CFRelease out)))))
+
+  (define-values (in-buffer-in in-buffer-out) (make-pipe))
+  (define IN-BUFFER-SIZE 4096)
+  (define in-buffer (make-bytes IN-BUFFER-SIZE))
+    
+  (define lock (make-semaphore 1))
+
+  ;; Callbacks used below (written here so that they're allocated once):
+  (define (lock-unavailable/read) (wrap-evt lock (lambda () 0)))
+  (define (lock-unavailable/write) (wrap-evt lock (lambda () #f)))
+
+  (define (read-in bstr)
+    (define n (read-bytes-avail!* bstr in-buffer-in))
+    (cond
+     [(positive? n) n]
+     [(zero? n)
+      (void (semaphore-try-wait? in-ready))
+      (cond
+       [(CFReadStreamHasBytesAvailable in)
+        (define use-bstr
+          (if ((bytes-length bstr) . < . IN-BUFFER-SIZE)
+              in-buffer
+              bstr))
+        (define n (CFReadStreamRead in use-bstr (bytes-length use-bstr)))
+        (cond
+         [(zero? n) eof]
+         [(negative? n)
+          (raise-osx-ssl-network-error 'read-bytes
+                                       (CFReadStreamGetError in))]
+         [else
+          (cond
+           [(eq? use-bstr in-buffer)
+            (write-bytes in-buffer in-buffer-out 0 n)
+            ;; Try again:
+            0]
+           [else n])])]
+       [(equal? (CFReadStreamGetStatus in)
+                'kCFStreamStatusError)
+        (raise-osx-ssl-network-error 'read-bytes
+                                     (CFReadStreamGetError in))]
+       [else
+        (wrap-evt (semaphore-peek-evt in-ready) (lambda (v) 0))])]))
+  
+  (define (write-out bstr start end buffer? breakable?)
+    (cond
+     [(= start end) 0]
+     [else
+      (void (semaphore-try-wait? out-ready))
+      (cond
+       [(CFWriteStreamCanAcceptBytes out)
+        (let ([n (CFWriteStreamWrite out
+                                     (if (zero? start)
+                                         bstr
+                                         (substring bstr start end))
+                                     (- end start))])
+          (cond
+           [(zero? n)
+            (wrap-evt always-evt (lambda (v) #f))]
+           [(n . < . -1)
+            (raise-osx-ssl-network-error 'write-bytes
+                                         (CFWriteStreamGetError out))]
+           [else n]))]
+       [(equal? (CFWriteStreamGetStatus out)
+                'kCFStreamStatusError)
+        (raise-osx-ssl-network-error 'write-bytes
+                                     (CFWriteStreamGetError out))]
+       [else
+        (wrap-evt (semaphore-peek-evt out-ready) (lambda (v) #f))])]))
+
+  (values (make-input-port/read-to-peek
+           'osx-ssl
+           ;; read:
+           (lambda (bstr)
+             (call-with-semaphore
+              lock
+              read-in
+              lock-unavailable/read
+              bstr))
+           ;; peek:
+           (lambda (bstr offset slow)
+             ;; Try fast peek on buffer port:
+             (define n (peek-bytes-avail!* bstr offset #f in-buffer-in))
+             (if (zero? n)
+                 (slow bstr offset)
+                 n))
+           (lambda ()
+             (call-with-semaphore
+              lock
+              (lambda ()
+                (CFReadStreamClose in)
+                (close!)))))
+          
+          (osx-ssl-output-port
+           (make-output-port
+            'osx-ssl
+            (semaphore-peek-evt out-ready)
+            ;; write
+            (lambda (bstr start end non-block? enable-break?)
+              (call-with-semaphore
+               lock
+               write-out                  
+               lock-unavailable/write
+               bstr start end non-block? enable-break?))
+            ;; close
+            (lambda ()
+              (call-with-semaphore
+               lock
+               (lambda () 
+                 (unless skip-close-out?
+                   (CFWriteStreamClose out))
+                 (close!)))))
+           ;; abandon:
+           (lambda (self)
+             (set! skip-close-out? #t)
+             (close-output-port self)))))
+
+(struct osx-ssl-output-port (port abandon)
+        #:property prop:output-port 0)
+
+(define (osx-ssl-abandon-port p)
+  (if (osx-ssl-output-port? p)
+      ((osx-ssl-output-port-abandon p) p)
+      (close-output-port p)))
+
+(define (raise-osx-ssl-network-error who err)
+  (exn:fail:network
+   (~a who ": failed " (CFStreamError->list err))
+   (current-continuation-marks)))

racket/collects/net/url-connect.rkt

@@ -4,7 +4,8 @@
                     [tcp-connect plain-tcp-connect]
                     [tcp-abandon-port plain-tcp-abandon-port])
          openssl
-         "win32-ssl.rkt")
+         "win32-ssl.rkt"
+         "osx-ssl.rkt")
 
 (provide (all-defined-out))
 
@@ -16,14 +17,19 @@
 ;; `current-connect-scheme'
 (define (tcp-connect host port)
   (cond [(equal? (current-connect-scheme) "https")
-         (if (or ssl-available?
+         (cond
+          [(osx-old-openssl?)
+           (osx-ssl-connect host port (current-https-protocol))]
+          [(or ssl-available?
                (not win32-ssl-available?))
-             (ssl-connect host port (current-https-protocol))
+           (ssl-connect host port (current-https-protocol))]
-             (win32-ssl-connect host port (current-https-protocol)))]
+          [else
+           (win32-ssl-connect host port (current-https-protocol))])]
         [else
          (plain-tcp-connect host port)]))
 
 (define (tcp-abandon-port port)
   (cond [(ssl-port? port) (ssl-abandon-port port)]
         [(win32-ssl-port? port) (win32-ssl-abandon-port port)]
+        [(osx-ssl-output-port? port) (osx-ssl-abandon-port port)]
         [else (plain-tcp-abandon-port port)]))

racket/collects/openssl/libcrypto.rkt

@@ -44,6 +44,9 @@
 (define-runtime-path libcrypto-so
   (case (system-type)
     [(windows) '(so "libeay32")]
+    [(macosx)
+     ;; Version "1.0.0" is bundled with Racket
+     '(so "libcrypto" ("1.0.0" #f))]
     [else '(so "libcrypto")]))
 
 (define libcrypto

racket/collects/openssl/libssl.rkt

@@ -14,6 +14,9 @@
 (define-runtime-path libssl-so
   (case (system-type)
     [(windows) '(so "ssleay32")]
+    [(macosx)
+     ;; Version "1.0.0" is bundled with Racket
+     '(so "libssl" ("1.0.0" #f))]
     [else '(so "libssl")]))
 
 (define libssl

racket/src/native-libs/build-all.rkt

@@ -18,11 +18,11 @@
    (cond
     [(or win? linux?)
      '("sqlite"
-       "openssl"
        "zlib")]
     [else
      null])
-   '("expat"
+   '("openssl"
+     "expat"
      "gettext")
    (cond
     [linux?

racket/src/native-libs/build.rkt

@@ -314,21 +314,33 @@
                           (~a "cd " (build-path dest "bin")
                               " && mv libsqlite3-0.dll sqlite3.dll")))]
     [("openssl")
-     (nonmac-only)
+     (define make
+       (if linux?
+           (~a "make SHARED_LDFLAGS=" "-Wl,-rpath," dest "/lib")
+           "make"))
      (config #:configure-exe (find-executable-path "sh")
-             #:configure (if win?
+             #:configure (cond
+                          [win?
                            (list "./Configure"
                                  (~a "--cross-compile-prefix=" win-prefix "-")
                                  #f ; other flags here
                                  (~a "mingw" (if m32? "" "64"))
-				   "shared")
+                                 "shared")]
+                          [mac?
                            (list "./Configure"
                                  #f
                                  "shared"
-				   "linux-x86_64"))
+                                 (cond
-	     #:make (if linux?
+                                  [ppc? "darwin-ppc-cc"]
-			(~a "make SHARED_LDFLAGS=" "-Wl,-rpath," dest "/lib")
+                                  [m32? "darwin-i386-cc"]
-			"make"))]
+                                  [else "darwin64-x86_64-cc"]))]
+                          [else
+                           (list "./Configure"
+                                 #f
+                                 "shared"
+                                 "linux-x86_64")])
+	     #:make make
+             #:make-install (~a make " install_sw"))]
     [("expat") (config)]
     [("gettext") (config #:depends (if win? '("libiconv") '())
                          #:configure '("--enable-languages=c")

racket/src/native-libs/install.rkt

@@ -39,6 +39,10 @@
     "zlib1"
     "libpangowin32-1.0.0"))
 
+(define nonwin-libs
+  '("libcrypto.1.0.0"
+    "libssl.1.0.0"))
+
 (define linux-libs
   (append
    '("libXau.6"
@@ -49,9 +53,7 @@
      "libXext.6"
      "libXrender.1"
      "fonts")
-   '("libcrypto.1.0.0"
+   '("libz.1"
-     "libssl.1.0.0"
-     "libz.1"
      "libsqlite3.0")
    '("libgtk-x11-2.0.0"
      "libgdk-x11-2.0.0"
@@ -323,6 +325,8 @@
 (define (install-mac)
   (define (fixup p p-new)
     (printf "Fixing ~s\n" p-new)
+    (unless (memq 'write (file-or-directory-permissions p-new))
+      (file-or-directory-permissions p-new #o744))
     (system (format "install_name_tool -id ~a ~a" (file-name-from-path p-new) p-new))
     (for-each (lambda (s)
                 (system (format "install_name_tool -change ~a @loader_path/~a ~a" 
@@ -337,7 +341,7 @@
                            "x86_64")
                        "-macosx"))
   
-  (install platform platform "dylib" fixup libs))
+  (install platform platform "dylib" fixup (append libs nonwin-libs)))
 
 (define (install-win)
   (define exe-prefix (if m32?
@@ -398,6 +402,7 @@
 
   (install platform platform add-so fixup (append (remove* linux-remove-libs
 							   libs)
+                                                  nonwin-libs
 						  linux-libs)))
 
 (cond

racket/src/racket/src/port.c

@@ -11310,6 +11310,48 @@ void scheme_end_sleeper_thread()
 
 #endif
 
+/*========================================================================*/
+/*                           thread helper                                */
+/*========================================================================*/
+
+/* The scheme_call_sequence() functionc an be used, with some care,
+   via the FFI to run a computation in a foreign thread and thread
+   results through. Keeping the number of procedures below
+   `NUM_COPIED_SEQUENCE_PROCS` can potentially simplify things, too */
+
+#define NUM_COPIED_SEQUENCE_PROCS 5
+
+typedef void *(*Scheme_Sequenced_Proc)(void *);
+
+struct Scheme_Proc_Sequence {
+  Scheme_Object *num_procs; /* pointer simplifies allocation issues */
+  void *init_data;
+  Scheme_Sequenced_Proc p[mzFLEX_ARRAY_DECL];
+};
+
+void *scheme_call_sequence_of_procedures(struct Scheme_Proc_Sequence *s)
+  XFORM_SKIP_PROC
+{
+  int i, num_procs = SCHEME_INT_VAL(s->num_procs);
+  void *data = s->init_data;
+  Scheme_Sequenced_Proc copied[NUM_COPIED_SEQUENCE_PROCS];
+
+  if (num_procs <= NUM_COPIED_SEQUENCE_PROCS) {
+    for (i = 0; i < num_procs; i++) {
+      copied[i] = s->p[i];
+    }
+  }
+
+  for (i = 0; i < num_procs; i++) {
+    if (num_procs <= NUM_COPIED_SEQUENCE_PROCS)
+      data = copied[i](data);
+    else
+      data = s->p[i](data);
+  }
+
+  return data;
+}
+
 /*========================================================================*/
 /*                       memory debugging help                            */
 /*========================================================================*/