From 22189ed117afe435f56a1c0c7bd948e3650c6e4c Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Tue, 4 Dec 2012 23:02:22 +0000 Subject: [PATCH] Add (guix gnu-maintenance). * guix/gnu-maintenance.scm: New file. * Makefile.am (MODULES): Add it. --- Makefile.am | 1 + guix/gnu-maintenance.scm | 57 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+) create mode 100644 guix/gnu-maintenance.scm diff --git a/Makefile.am b/Makefile.am index 2500c0e2a7..fab85aebe2 100644 --- a/Makefile.am +++ b/Makefile.am @@ -27,6 +27,7 @@ MODULES = \ guix/utils.scm \ guix/derivations.scm \ guix/download.scm \ + guix/gnu-maintenance.scm \ guix/build-system.scm \ guix/build-system/gnu.scm \ guix/build-system/trivial.scm \ diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm new file mode 100644 index 0000000000..2035e44fdb --- /dev/null +++ b/guix/gnu-maintenance.scm @@ -0,0 +1,57 @@ +;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +;;; Copyright (C) 2012 Nikita Karetnikov +;;; Copyright (C) 2012 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix gnu-maintenance) + #:use-module (web uri) + #:use-module (web client) + #:use-module (web response) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:export (official-gnu-packages)) + +(define (http-fetch uri) + "Return a string containing the textual data at URI, a string." + (let*-values (((resp data) + (http-get (string->uri uri))) + ((code) + (response-code resp))) + (case code + ((200) + data) + (else + (error "download failed:" uri code + (response-reason-phrase resp)))))) + +(define %package-list-url + (string-append "http://cvs.savannah.gnu.org/" + "viewvc/*checkout*/gnumaint/" + "gnupackages.txt?root=womb")) + +(define (official-gnu-packages) + "Return a list of GNU packages." + (define %package-line-rx + (make-regexp "^package: (.+)$")) + + (let ((lst (string-split (http-fetch %package-list-url) #\nl))) + (filter-map (lambda (line) + (and=> (regexp-exec %package-line-rx line) + (cut match:substring <> 1))) + lst)))