diff options
author | Ludovic Courtès <ludo@gnu.org> | 2012-11-13 00:22:44 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2012-11-13 00:23:39 +0100 |
commit | 87f5d36630db13fee1f2c0563505dc0938f3787e (patch) | |
tree | 9cbbbd3d3c47b647ff7b3131cf8271586e5167a6 /guix | |
parent | 62cab99c3297a066f466780bb4d83a4f142538c7 (diff) |
Remove (guix http) and (guix ftp).
* guix/ftp.scm, guix/http.scm, guix/build/ftp.scm, guix/build/http.scm:
Remove.
* Makefile.am (MODULES): Likewise.
* tests/builders.scm, distro/packages/base.scm,
distro/packages/bash.scm, distro/packages/bdw-gc.scm,
distro/packages/compression.scm, distro/packages/gawk.scm,
distro/packages/gnupg.scm, distro/packages/gperf.scm,
distro/packages/guile.scm, distro/packages/libffi.scm,
distro/packages/libsigsegv.scm, distro/packages/libtool.scm,
distro/packages/libunistring.scm, distro/packages/lout.scm,
distro/packages/m4.scm, distro/packages/multiprecision.scm,
distro/packages/ncurses.scm, distro/packages/perl.scm,
distro/packages/pkg-config.scm, distro/packages/pth.scm,
distro/packages/readline.scm, distro/packages/recutils.scm: Use
`url-fetch' instead of `http-fetch' and `ftp-fetch'.
* distro/packages/bootstrap.scm: Likewise
(bootstrap-origin): Remove references to `http-fetch' and
`ftp-fetch'.
* guix.scm (%public-modules): Remove `http' and `ftp'; add `download'.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/ftp.scm | 48 | ||||
-rw-r--r-- | guix/build/http.scm | 100 | ||||
-rw-r--r-- | guix/ftp.scm | 65 | ||||
-rw-r--r-- | guix/http.scm | 63 |
4 files changed, 0 insertions, 276 deletions
diff --git a/guix/build/ftp.scm b/guix/build/ftp.scm deleted file mode 100644 index 17486953c2..0000000000 --- a/guix/build/ftp.scm +++ /dev/null @@ -1,48 +0,0 @@ -;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- -;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> -;;; -;;; This file is part of Guix. -;;; -;;; Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with Guix. If not, see <http://www.gnu.org/licenses/>. - -(define-module (guix build ftp) - #:use-module (guix ftp-client) - #:use-module (guix build utils) - #:use-module (web uri) - #:export (ftp-fetch)) - -;;; Commentary: -;;; -;;; Fetch data such as tarballs over FTP (builder-side code). -;;; -;;; Code: - -(define (ftp-fetch url file) - "Fetch data from URL and write it to FILE. Return FILE on success." - - (setvbuf (current-output-port) _IOLBF) - (format #t "starting FTP download of `~a' from `~a'...~%" file url) - (let* ((uri (string->uri url)) - (conn (ftp-open (uri-host uri))) - (in (ftp-retr conn (basename (uri-path uri)) - (dirname (uri-path uri))))) - (call-with-output-file file - (lambda (out) - ;; TODO: Show a progress bar. - (dump-port in out))) - - (ftp-close conn)) - file) - -;;; ftp.scm ends here diff --git a/guix/build/http.scm b/guix/build/http.scm deleted file mode 100644 index 65c09fa4cd..0000000000 --- a/guix/build/http.scm +++ /dev/null @@ -1,100 +0,0 @@ -;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- -;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> -;;; -;;; This file is part of Guix. -;;; -;;; Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with Guix. If not, see <http://www.gnu.org/licenses/>. - -(define-module (guix build http) - #:use-module (web uri) - #:use-module (web client) - #:use-module (web response) - #:use-module (rnrs io ports) - #:use-module (srfi srfi-11) - #:export (http-fetch)) - -;;; Commentary: -;;; -;;; Fetch data such as tarballs over HTTP (builder-side code). -;;; -;;; Code: - -(define (open-connection-for-uri uri) - "Return an open input/output port for a connection to URI. - -This is the same as Guile's `open-socket-for-uri', except that we always -use a numeric port argument, to avoid the need to go through libc's NSS, -which is not available during bootstrap." - (define addresses - (let ((port (or (uri-port uri) - (case (uri-scheme uri) - ((http) 80) ; /etc/services, not for me! - (else - (error "unsupported URI scheme" uri)))))) - (getaddrinfo (uri-host uri) - (number->string port) - AI_NUMERICSERV))) - - (let loop ((addresses addresses)) - (let* ((ai (car addresses)) - (s (with-fluids ((%default-port-encoding #f)) - (socket (addrinfo:fam ai) (addrinfo:socktype ai) - (addrinfo:protocol ai))))) - (catch 'system-error - (lambda () - (connect s (addrinfo:addr ai)) - - ;; Buffer input and output on this port. - (setvbuf s _IOFBF) - ;; Enlarge the receive buffer. - (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024)) - s) - (lambda args - ;; Connection failed, so try one of the other addresses. - (close s) - (if (null? addresses) - (apply throw args) - (loop (cdr addresses)))))))) - -;; XXX: This is an awful hack to make sure the (set-port-encoding! p -;; "ISO-8859-1") call in `read-response' passes, even during bootstrap -;; where iconv is not available. -(module-define! (resolve-module '(web response)) - 'set-port-encoding! - (lambda (p e) #f)) - -(define (http-fetch url file) - "Fetch data from URL and write it to FILE. Return FILE on success." - - (setvbuf (current-output-port) _IOLBF) - (format #t "starting HTTP download of `~a' from `~a'...~%" file url) - - ;; FIXME: Use a variant of `http-get' that returns a port instead of - ;; loading everything in memory. - (let*-values (((uri) - (string->uri url)) - ((connection) - (open-connection-for-uri uri)) - ((resp bv) - (http-get uri #:port connection #:decode-body? #f)) - ((code) - (response-code resp))) - (if (= 200 code) - (begin - (call-with-output-file file - (lambda (p) - (put-bytevector p bv))) - file) - (error "download failed" url - code (response-reason-phrase resp))))) diff --git a/guix/ftp.scm b/guix/ftp.scm deleted file mode 100644 index 2717bf3fb3..0000000000 --- a/guix/ftp.scm +++ /dev/null @@ -1,65 +0,0 @@ -;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- -;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> -;;; -;;; This file is part of Guix. -;;; -;;; Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with Guix. If not, see <ftp://www.gnu.org/licenses/>. - -(define-module (guix ftp) - #:use-module (ice-9 match) - #:use-module (guix derivations) - #:use-module (guix packages) - #:use-module ((guix store) #:select (derivation-path?)) - #:use-module (guix utils) - #:export (ftp-fetch)) - -;;; Commentary: -;;; -;;; Produce fixed-output derivations with data fetched over FTP. -;;; -;;; Code: - -(define* (ftp-fetch store url hash-algo hash - #:optional name - #:key (system (%current-system)) guile) - "Return the path of a fixed-output derivation in STORE that fetches URL, -which is expected to have hash HASH of type HASH-ALGO (a symbol). By -default, the file name is the base name of URL; optionally, NAME can specify -a different file name." - (define builder - `(begin - (use-modules (guix build ftp)) - (ftp-fetch ,url %output))) - - (define guile-for-build - (match guile - ((? package?) - (package-derivation store guile system)) - ((and (? string?) (? derivation-path?)) - guile) - (#f ; the default - (let* ((distro (resolve-interface '(distro packages base))) - (guile (module-ref distro 'guile-final))) - (package-derivation store guile system))))) - - (build-expression->derivation store (or name (basename url)) system - builder '() - #:hash-algo hash-algo - #:hash hash - #:modules '((guix ftp-client) - (guix build ftp) - (guix build utils)) - #:guile-for-build guile-for-build)) - -;;; ftp.scm ends here diff --git a/guix/http.scm b/guix/http.scm deleted file mode 100644 index 182d011b77..0000000000 --- a/guix/http.scm +++ /dev/null @@ -1,63 +0,0 @@ -;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- -;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> -;;; -;;; This file is part of Guix. -;;; -;;; Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with Guix. If not, see <http://www.gnu.org/licenses/>. - -(define-module (guix http) - #:use-module (ice-9 match) - #:use-module (guix derivations) - #:use-module (guix packages) - #:use-module ((guix store) #:select (derivation-path?)) - #:use-module (guix utils) - #:export (http-fetch)) - -;;; Commentary: -;;; -;;; Produce fixed-output derivations with data fetched over HTTP. -;;; -;;; Code: - -(define* (http-fetch store url hash-algo hash - #:optional name - #:key (system (%current-system)) guile) - "Return the path of a fixed-output derivation in STORE that fetches URL, -which is expected to have hash HASH of type HASH-ALGO (a symbol). By -default, the file name is the base name of URL; optionally, NAME can specify -a different file name." - (define builder - `(begin - (use-modules (guix build http)) - (http-fetch ,url %output))) - - (define guile-for-build - (match guile - ((? package?) - (package-derivation store guile system)) - ((and (? string?) (? derivation-path?)) - guile) - (#f ; the default - (let* ((distro (resolve-interface '(distro packages base))) - (guile (module-ref distro 'guile-final))) - (package-derivation store guile system))))) - - (build-expression->derivation store (or name (basename url)) system - builder '() - #:hash-algo hash-algo - #:hash hash - #:modules '((guix build http)) - #:guile-for-build guile-for-build)) - -;;; http.scm ends here |