diff options
author | Ludovic Courtès <ludo@gnu.org> | 2012-09-12 23:47:49 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2012-09-12 23:47:49 +0200 |
commit | 457dd86d66bc1ee1ee13a76d03792396fb69ee34 (patch) | |
tree | f652df780af8245b51b0363545f938aa40586950 /guix/build/ftp.scm | |
parent | fb585745adcd2935b179db1ce847318ec3724c4e (diff) | |
download | gnu-guix-457dd86d66bc1ee1ee13a76d03792396fb69ee34.tar gnu-guix-457dd86d66bc1ee1ee13a76d03792396fb69ee34.tar.gz |
Add (guix ftp) and companion modules.
* guix/ftp-client.scm, guix/ftp.scm, guix/build/ftp.scm: New files.
* Makefile.am (MODULES): Add them.
* distro/base.scm (libffi): Use `ftp-fetch'.
Diffstat (limited to 'guix/build/ftp.scm')
-rw-r--r-- | guix/build/ftp.scm | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/guix/build/ftp.scm b/guix/build/ftp.scm new file mode 100644 index 0000000000..17486953c2 --- /dev/null +++ b/guix/build/ftp.scm @@ -0,0 +1,48 @@ +;;; 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 |