From 7c638a03a0658a1ffe6f9498ff957a17e25d95ee Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 11 Aug 2013 14:36:20 -0600 Subject: [PATCH] remove some obsolete files --- racket/src/download-libs.rkt | 132 ------------------- racket/src/get-libs.rkt | 246 ----------------------------------- 2 files changed, 378 deletions(-) delete mode 100644 racket/src/download-libs.rkt delete mode 100644 racket/src/get-libs.rkt diff --git a/racket/src/download-libs.rkt b/racket/src/download-libs.rkt deleted file mode 100644 index 776cda133c..0000000000 --- a/racket/src/download-libs.rkt +++ /dev/null @@ -1,132 +0,0 @@ -#lang racket/base - -(require racket/tcp) -(provide do-download) - -(define-values (http-proxy-host http-proxy-port) - (let ([http-proxy (getenv "http_proxy")]) - (if http-proxy - (let ((matched (regexp-match #rx"^(?:[Hh][Tt][Tt][Pp]://)?([^:]+)(?::([0-9]+))?$" http-proxy))) - (if matched - (values (list-ref matched 1) - (or (and (list-ref matched 2) - (string->number (list-ref matched 2))) - 80)) - (begin - (printf "Could not parse `http_proxy' value: ~e\n" http-proxy) - (values #f #f)))) - (values #f #f)))) -(when http-proxy-host - (printf ">> Proxy detected: host ~a port ~a\n" http-proxy-host http-proxy-port)) - - -(define url-host "download.racket-lang.org") -(define url-path "/libs/13/") -(define url-base (string-append "http://" url-host url-path)) -(define architecture #f) ;; set in `do-download' - -(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)) - (if (eq? (system-type) 'windows) - ;; Use a rename-and-delete dance that lets us replace - ;; a DLL that might be in use by the Racket process - ;; that is running the download: - (let ([new-path (path-add-suffix path #".del")]) - (when (file-exists? new-path) - (delete-file new-path)) - (rename-file-or-directory path new-path) - (with-handlers ([exn:fail:filesystem? - (lambda (exn) - (log-error (exn-message exn)))]) - (delete-file new-path))) - (delete-file path))])) - -(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 target) - (define src (format "~a~a/~a" url-path architecture file)) - (define-values [i o] (if http-proxy-host - (tcp-connect http-proxy-host http-proxy-port) - (tcp-connect url-host 80))) - (if http-proxy-host - (fprintf o "GET ~a~a~a HTTP/1.0\r\nHost: ~a\r\n\r\n" "http://" url-host src url-host) - (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) - - (call-with-output-file target #:exists 'truncate/replace - (λ (out) (copy-port i out)))) - -(define (download file size) - (define tmp (format "~a.download" file)) - (let loop ([n 0]) - (when (> n 0) (printf " retry #~a," n) (flush-output)) - (define thd (thread (λ () (download* file tmp)))) - (unless (sync/timeout (+ 10 (* 5 n)) thd) - (kill-thread thd) - (when (> n 3) (raise-user-error 'download "could not retrieve ~a" file)) - (when (zero? n) (printf " timeout,")) - (loop (add1 n)))) - (when (file-exists? file) (delete-path file)) - (rename-file-or-directory tmp file #t) - (define 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 (do-download needed really-needed arch) - (set! architecture arch) - (printf ">> Downloading files from\n>> ~a~a\n" url-base architecture) - (printf ">> (set the `http_proxy' environment variable if a proxy is needed)\n") - (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")))) diff --git a/racket/src/get-libs.rkt b/racket/src/get-libs.rkt deleted file mode 100644 index d2c27dd882..0000000000 --- a/racket/src/get-libs.rkt +++ /dev/null @@ -1,246 +0,0 @@ -;; This program is written in #%kernel and -;; dynamic-requires the real downloading, -;; because it is loaded without using bytecode. -(module get-libs '#%kernel - (#%require '#%paramz (for-syntax '#%kernel)) - (#%provide all-files+sizes) - - (define-values (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 - (list - ;; Core Libraries - '[core - [win32/i386 - ["iconv.dll" 892928] - ["libeay32.dll" 1099776] - ["ssleay32.dll" 239104] - ["longdouble.dll" 114786]] - [win32/x86_64 - ["libiconv-2.dll" 1378028] - ["libeay32.dll" 1503232] - ["ssleay32.dll" 309760] - ["longdouble.dll" 125176]]] - ;; Math Libraries - '[math - [i386-macosx - ["libgmp.10.dylib" 399304] - ["libmpfr.4.dylib" 398552]] - [x86_64-macosx - ["libgmp.10.dylib" 429684] - ["libmpfr.4.dylib" 676320]] - [ppc-macosx - ["libgmp.10.dylib" 387588] - ["libmpfr.4.dylib" 553892]] - [win32/i386 - ["libgmp-10.dll" 394766] - ["libmpfr-4.dll" 411662]] - [win32/x86_64 - ["libgmp-10.dll" 386048] - ["libmpfr-4.dll" 441344]]] - ;; GUI Libraries - [list - 'gui - '[i386-macosx - ["libcairo.2.dylib" 802620] - ["libffi.5.dylib" 22424] - ["libintl.8.dylib" 63084] - ["libgio-2.0.0.dylib" 1511444] - ["libjpeg.62.dylib" 412024] - ["libglib-2.0.0.dylib" 1272192] - ["libpango-1.0.0.dylib" 351672] - ["libgmodule-2.0.0.dylib" 18820] - ["libpangocairo-1.0.0.dylib" 83928] - ["libgobject-2.0.0.dylib" 308304] - ["libpixman-1.0.dylib" 526716] - ["libgthread-2.0.0.dylib" 12708] - ["libpng15.15.dylib" 200876] - ["PSMTabBarControl.tgz" 94103 "PSMTabBarControl.framework" 251764]] - '[x86_64-macosx - ["libcairo.2.dylib" 926648] - ["libffi.5.dylib" 23568] - ["libintl.8.dylib" 63156] - ["libgio-2.0.0.dylib" 2136056] - ["libjpeg.62.dylib" 153360] - ["libglib-2.0.0.dylib" 1689952] - ["libpango-1.0.0.dylib" 392432] - ["libgmodule-2.0.0.dylib" 19768] - ["libpangocairo-1.0.0.dylib" 97352] - ["libgobject-2.0.0.dylib" 438192] - ["libpixman-1.0.dylib" 633368] - ["libgthread-2.0.0.dylib" 8592] - ["libpng15.15.dylib" 214836] - ["PSMTabBarControl.tgz" 156265 "PSMTabBarControl.framework" 450751]] - '[ppc-macosx - ["libcairo.2.dylib" 2620616] - ["libffi.5.dylib" 67920] - ["libintl.8.dylib" 132252] - ["libgio-2.0.0.dylib" 937488] - ["libjpeg.62.dylib" 209688] - ["libglib-2.0.0.dylib" 1242448] - ["libpango-1.0.0.dylib" 760792] - ["libgmodule-2.0.0.dylib" 19476] - ["libpangocairo-1.0.0.dylib" 195372] - ["libgobject-2.0.0.dylib" 352680] - ["libpixman-1.0.dylib" 1626104] - ["libgthread-2.0.0.dylib" 25068] - ["libpng15.15.dylib" 570228] - ["PSMTabBarControl.tgz" 96039 "PSMTabBarControl.framework" 229501]] - (append - '[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" 143647] - ["libpangoft2-1.0-0.dll" 679322]] - (if (environment-variables-ref (current-environment-variables) - #"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" 151879] - ["libpangoft2-1.0-0.dll" 1188615]]] - ;; Database libraries - '[db - [win32/i386 - ["sqlite3.dll" 570947]] - [win32/x86_64 - ["sqlite3.dll" 617472]]] - ;; COM libraries - '[com - [win32/i386 - ["myssink.dll" 92672]] - [win32/x86_64 - ["myssink.dll" 108032]]])) - - (define-values [package dest-dir] - (let-values ([(args) (vector->list (current-command-line-arguments))]) - (let-values - ([(package) (if (null? args) - (error 'get-libs "missing \'package\' command-line argument") - (car args))]) - (let-values ([(dd) - (if (null? (cdr args)) (current-directory) (cadr args))]) - (values (string->symbol package) dd))))) - - (define-values (unixize) - (lambda (p) - (let-values ([(base name dir?) (split-path p)]) - (if (path? base) - (string-append (unixize base) "/" (path->string name)) - (path->string name))))) - - (define-values (architecture) - (string->symbol (unixize (system-library-subpath #f)))) - - (define-values (needed-files+sizes) - (lambda () - (define-values (l) (assq package all-files+sizes)) - (define-values (files+sizes) - (cdr (if l - l - (error 'get-libs "bad package: ~s, expecting one of ~s" - package (map car all-files+sizes))))) - (define-values (arch) (assq architecture files+sizes)) - (if arch - (cdr arch) - '()))) - - (define-values (directory-size) - (lambda (dir) - (define-values (loop) - (lambda (l) - (if (null? l) - 0 - (+ (path-size (build-path dir (car l))) (loop (cdr l)))))) - (loop (directory-list dir)))) - - (define-values (path-size) - (lambda (path) - (if (file-exists? path) (file-size path) - (if (directory-exists? path) - (directory-size path) - 0)))) - - (define-values (path-size/show) - (lambda (path) - (let-values ([(sz) (path-size path)]) - (if (environment-variables-ref (current-environment-variables) - #"PLT_SHOW_PATH_SIZES") - (printf "~s ~s\n" path sz) - (void)) - sz))) - - (define-values (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/show path))])) - - ;; not provided by #%kernel - (define-values (filter) - (lambda (f l) - (if (null? l) - l - (if (f (car l)) - (cons (car l) (filter f (cdr l))) - (filter f (cdr l)))))) - - (define-syntaxes (here-dir) - (λ (stx) - (define-values (base name dir?) (split-path (syntax-source stx))) - (datum->syntax (quote-syntax 'here) base))) - - (if (eq? package 'nothing) - (void) - (begin - (if (directory-exists? dest-dir) (void) (make-directory dest-dir)) - (with-continuation-mark parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - current-directory dest-dir) - (let-values () - (define-values (needed) (needed-files+sizes)) - (define-values (really-needed) - (filter (λ (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) - (if (null? needed) - (void) - (if (null? really-needed) - (printf ">> All files present, no downloads needed.\n") - ((dynamic-require (build-path here-dir "download-libs.rkt") 'do-download) - needed really-needed architecture))))))))