racket/src/get-libs.rkt
Matthew Flatt 6a8d3c34f1 win64: avoid msvcr90.dll
The libjpeg, libeay, and ssleay libraries for Win64 linked to
msvcr90.dll, because of the way that they were compiled with
MSVC 2008, but msvcr90.dll is not included with Win7, and
redistributing it is problematic. The new variants of the libraries
link instead of msvcrt.dll --- which you're not supposed to do
according to MS, but that's the way libraries like Gtk are
built, and it seems to be the right approach. See also

 http://kobyk.wordpress.com/2007/07/20/dynamically-linking-with-msvcrtdll-using-visual-c-2005/

I built libjpeg-8, while the other two are courtesey of
http://www.indyproject.org.

Closes PR 12246
2011-10-05 06:28:31 -06:00

238 lines
8.4 KiB
Racket

#lang racket/base
(require racket/cmdline racket/tcp)
;; This program avoids racket/port and net/url, because it is loaded
;; without using bytecode.
(define url-host "download.racket-lang.org")
(define url-path "/libs/4/")
(define url-base (string-append "http://" url-host url-path))
(provide all-files+sizes)
(define all-files+sizes
;; alist mapping package to
;; alist mapping architecture to
;; a list of entries, each has filename and size
;; and optionally a path that it would install to and the installed size
`(;; Core Libraries
[core
[win32/i386
["iconv.dll" 892928]
["libeay32.dll" 1089536]
["ssleay32.dll" 237568]]
[win32/x86_64
["libiconv-2.dll" 1378028]
["libeay32.dll" 1410560]
["ssleay32.dll" 247808]]]
;; GUI Libraries
[gui
[i386-macosx
["libcairo.2.dylib" 803196]
["libintl.8.dylib" 57604]
["libgio-2.0.0.dylib" 736720]
["libjpeg.62.dylib" 412024]
["libglib-2.0.0.dylib" 1009572]
["libpango-1.0.0.dylib" 345476]
["libgmodule-2.0.0.dylib" 18836]
["libpangocairo-1.0.0.dylib" 83612]
["libgobject-2.0.0.dylib" 284384]
["libpixman-1.0.dylib" 526564]
["libgthread-2.0.0.dylib" 24368]
["libpng14.14.dylib" 182732]
["PSMTabBarControl.tgz" 94103 "PSMTabBarControl.framework" 251764]]
[x86_64-macosx
["libcairo.2.dylib" 919840]
["libintl.8.dylib" 61016]
["libgio-2.0.0.dylib" 897624]
["libjpeg.62.dylib" 153360]
["libglib-2.0.0.dylib" 1162256]
["libpango-1.0.0.dylib" 394768]
["libgmodule-2.0.0.dylib" 19832]
["libpangocairo-1.0.0.dylib" 94952]
["libgobject-2.0.0.dylib" 344024]
["libpixman-1.0.dylib" 577128]
["libgthread-2.0.0.dylib" 21728]
["libpng14.14.dylib" 192224]
["PSMTabBarControl.tgz" 107267 "PSMTabBarControl.framework" 316528]]
[ppc-macosx
["libcairo.2.dylib" 2716096]
["libintl.8.dylib" 133156]
["libgio-2.0.0.dylib" 936176]
["libjpeg.62.dylib" 209688]
["libglib-2.0.0.dylib" 1242368]
["libpango-1.0.0.dylib" 761292]
["libgmodule-2.0.0.dylib" 19872]
["libpangocairo-1.0.0.dylib" 199440]
["libgobject-2.0.0.dylib" 352728]
["libpixman-1.0.dylib" 1366816]
["libgthread-2.0.0.dylib" 25416]
["libpng14.14.dylib" 505920]
["PSMTabBarControl.tgz" 96039 "PSMTabBarControl.framework" 229501]]
[win32/i386
["libjpeg-7.dll" 233192]
["libcairo-2.dll" 921369]
["libpango-1.0-0.dll" 336626]
["libexpat-1.dll" 143096]
["libpng14-14.dll" 219305]
["zlib1.dll" 55808]
["freetype6.dll" 535264]
["libfontconfig-1.dll" 279059]
["libglib-2.0-0.dll" 1110713]
["libgobject-2.0-0.dll" 316586]
["libgmodule-2.0-0.dll" 31692]
["libpangocairo-1.0-0.dll" 94625]
["libpangowin32-1.0-0.dll" 102210]
["libpangoft2-1.0-0.dll" 679322]
,@(if (getenv "PLT_WIN_GTK")
'(["libatk-1.0-0.dll" 153763]
["libgtk-win32-2.0-0.dll" 4740156]
["libgdk-win32-2.0-0.dll" 827670]
["libgdk_pixbuf-2.0-0.dll" 252150]
["libgio-2.0-0.dll" 669318]
["libwimp.dll" 69632]
["gtkrc" 1181])
'())]
[win32/x86_64
["libjpeg-8.dll" 214016]
["libcairo-2.dll" 1266147]
["libpango-1.0-0.dll" 423199]
["libexpat-1.dll" 263006]
["libpng14-14.dll" 272473]
["zlib1.dll" 191825]
["libfreetype-6.dll" 633649]
["libintl-8.dll" 240862]
["libfontconfig-1.dll" 339943]
["libglib-2.0-0.dll" 1267577]
["libgobject-2.0-0.dll" 425888]
["libgmodule-2.0-0.dll" 119538]
["libgthread-2.0-0.dll" 126615]
["libpangocairo-1.0-0.dll" 185168]
["libpangowin32-1.0-0.dll" 192656]
["libpangoft2-1.0-0.dll" 1188615]]]))
(define-values [package dest-dir]
(command-line #:args [package [dest-dir (current-directory)]]
(values (string->symbol package) dest-dir)))
(define (unixize p)
(let-values ([(base name dir?) (split-path p)])
(if (path? base)
(string-append (unixize base) "/" (path->string name))
(path->string name))))
(define architecture (string->symbol (unixize (system-library-subpath #f))))
(define (needed-files+sizes)
(let ([files+sizes
(cdr (or (assq package all-files+sizes)
(error 'get-libs "bad package: ~s, expecting one of ~s"
package (map car all-files+sizes))))])
(cond [(assq architecture files+sizes) => cdr]
[else '()])))
(define (purify-port port)
(let ([m (regexp-match-peek-positions #rx#"^HTTP/.*?(?:\r\n\r\n|\n\n|\r\r)"
port)])
(if m (read-bytes (cdar m) port) "")))
(define (copy-port src dest)
(let ([s (make-bytes 4096)])
(let loop ()
(let ([c (read-bytes-avail! s src)])
(cond [(number? c)
(let loop ([start 0])
(unless (= start c)
(let ([c2 (write-bytes-avail s dest start c)])
(loop (+ start c2)))))
(loop)]
;; Must be EOF
[else (void)])))))
(define (download file size)
(define src (format "~a~a/~a" url-path architecture file))
(define-values [i o] (tcp-connect url-host 80))
(fprintf o "GET ~a HTTP/1.0\r\nHost: ~a\r\n\r\n" src url-host)
(flush-output o) (tcp-abandon-port o)
(purify-port i)
(define tmp (format "~a.download" file))
(call-with-output-file tmp #:exists 'truncate/replace
(lambda (out) (copy-port i out)))
(rename-file-or-directory tmp file #t)
(let ([sz (file-size file)])
(unless (= size sz)
(eprintf "\n")
(raise-user-error 'get-libs
"size of ~a is ~a; doesn't match expected size ~a"
file sz size))))
(define (unpack-tgz tgz)
(printf " unpacking...") (flush-output)
(define-values [p pout pin perr]
(subprocess
(current-output-port) (current-input-port) (current-error-port)
(find-executable-path "tar") "zxf" tgz))
(subprocess-wait p)
(delete-file tgz))
(define (install file)
(cond [(regexp-match? #rx"[.]tgz" file) (unpack-tgz file)]
[else (eprintf "\n")
(raise-user-error 'get-libs "don't know how to install file: ~a"
file)]))
(define (delete-path path)
(cond [(directory-exists? path)
(parameterize ([current-directory path])
(for-each delete-path (directory-list)))
(delete-directory path)]
[(or (file-exists? path) (link-exists? path)) (delete-file path)]))
(define (directory-size dir)
(parameterize ([current-directory dir])
(for/fold ([sum 0]) ([path (in-list (directory-list))])
(+ sum (path-size path)))))
(define (path-size path)
(cond [(file-exists? path) (file-size path)]
[(directory-exists? path) (directory-size path)]
[else 0]))
(define got-path? ; approximate, using size
(case-lambda [(path size unpacked-path unpacked-size)
(got-path? unpacked-path unpacked-size)]
[(path size)
(equal? size (path-size path))]))
(unless (eq? package 'nothing)
(unless (directory-exists? dest-dir) (make-directory dest-dir))
(parameterize ([current-directory dest-dir])
(define needed (needed-files+sizes))
(define really-needed
(filter (lambda (n) (not (apply got-path? n))) needed))
(printf (if (null? needed)
">> No ~a libraries to download for ~a\n"
">> Getting ~a libraries for ~a\n")
package architecture)
(cond
[(null? needed) (void)]
[(null? really-needed)
(printf ">> All files present, no downloads needed.\n")]
[else
(printf ">> Downloading files from\n>> ~a~a\n" url-base architecture)
(printf ">> If you don't want automatic download, download each file\n")
(printf ">> yourself from there to\n")
(printf ">> ~a\n" (path->complete-path (current-directory)))
(for ([file+size (in-list needed)])
(define file (car file+size))
(define size (cadr file+size))
(printf " ~a" file)
(if (member file+size really-needed)
(begin (printf " downloading...") (flush-output)
(download file size)
(when (pair? (cddr file+size))
(delete-path (caddr file+size))
(install file))
(printf " done.\n"))
(printf " already exists.\n")))])))