From 2cb0d7e771236309dcab8c5a4fe04b46f2929223 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 28 Jan 2017 22:17:08 -0600 Subject: [PATCH] Add guix.scm and patched live repl guile --- build-aux/patch-guile-fix-live-repl.patch | 65 ++++++++++++ guix.scm | 123 ++++++++++++++++++++++ 2 files changed, 188 insertions(+) create mode 100644 build-aux/patch-guile-fix-live-repl.patch create mode 100644 guix.scm diff --git a/build-aux/patch-guile-fix-live-repl.patch b/build-aux/patch-guile-fix-live-repl.patch new file mode 100644 index 0000000..fbfa130 --- /dev/null +++ b/build-aux/patch-guile-fix-live-repl.patch @@ -0,0 +1,65 @@ +From 4dfa5465fe813d86a6eb798fbdc549465f812d97 Mon Sep 17 00:00:00 2001 +From: Christopher Allan Webber +Date: Wed, 18 Jan 2017 17:27:09 -0600 +Subject: [PATCH] Revert "Adapt run-server* to change to `accept'." + +This reverts commit 206dced87f425af7eed628530313067a45bee2c2. +--- + module/system/repl/server.scm | 34 +++++++++++++++++++++++++--------- + 1 file changed, 25 insertions(+), 9 deletions(-) + +diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm +index f6981edf0..e7241c9ab 100644 +--- a/module/system/repl/server.scm ++++ b/module/system/repl/server.scm +@@ -78,6 +78,15 @@ + (bind sock AF_UNIX path) + sock)) + ++;; List of errno values from 'select' or 'accept' that should lead to a ++;; retry in 'run-server'. ++(define errs-to-retry ++ (delete-duplicates ++ (filter-map (lambda (name) ++ (and=> (module-variable the-root-module name) ++ variable-ref)) ++ '(EINTR EAGAIN EWOULDBLOCK)))) ++ + (define* (run-server #:optional (server-socket (make-tcp-server-socket))) + (run-server* server-socket serve-client)) + +@@ -98,15 +107,22 @@ + shutdown-read-pipe)) + + (define (accept-new-client) +- (let ((ready-ports (car (select monitored-ports '() '())))) +- ;; If we've been asked to shut down, return #f. +- (and (not (memq shutdown-read-pipe ready-ports)) +- ;; If the socket turns out to actually not be ready, this +- ;; will return #f. ECONNABORTED etc are still possible of +- ;; course. +- (or (false-if-exception (accept server-socket) +- #:warning "Failed to accept client:") +- (accept-new-client))))) ++ (catch #t ++ (lambda () ++ (let ((ready-ports (car (select monitored-ports '() '())))) ++ ;; If we've been asked to shut down, return #f. ++ (and (not (memq shutdown-read-pipe ready-ports)) ++ (accept server-socket)))) ++ (lambda k-args ++ (let ((err (system-error-errno k-args))) ++ (cond ++ ((memv err errs-to-retry) ++ (accept-new-client)) ++ (else ++ (warn "Error accepting client" k-args) ++ ;; Retry after a timeout. ++ (sleep 1) ++ (accept-new-client))))))) + + ;; Put the socket into non-blocking mode. + (fcntl server-socket F_SETFL +-- +2.11.0 + diff --git a/guix.scm b/guix.scm new file mode 100644 index 0000000..8cb315c --- /dev/null +++ b/guix.scm @@ -0,0 +1,123 @@ +;;; mudsync --- Live hackable MUDs in Guile +;;; Copyright (C) 2016 Jan Nieuwenhuizen +;;; Copyright (C) 2017 Christopher Allan Webber +;;; +;;; Also borrowing code from: +;;; guile-sdl2 --- FFI bindings for SDL2 +;;; Copyright © 2015 David Thompson +;;; +;;; This program 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. +;;; +;;; This program 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 this program. If not, see . + +;;; Commentary: +;; +;; GNU Guix development package. To build and install, run: +;; +;; guix package -f guix.scm +;; +;; To build it, but not install it, run: +;; +;; guix build -f guix.scm +;; +;; To use as the basis for a development environment, run: +;; +;; guix environment -l guix.scm +;; +;;; Code: + +(use-modules (srfi srfi-1) + (srfi srfi-26) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim) + (guix download) + (guix packages) + (guix licenses) + (guix gexp) + (guix git-download) + (guix build-system gnu) + ((guix build utils) #:select (with-directory-excursion)) + (gnu packages) + (gnu packages autotools) + (gnu packages guile) + (gnu packages pkg-config) + (gnu packages texinfo)) + +(define %source-dir (dirname (current-filename))) + +(define git-file? + (let* ((pipe (with-directory-excursion %source-dir + (open-pipe* OPEN_READ "git" "ls-files"))) + (files (let loop ((lines '())) + (match (read-line pipe) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + (status (close-pipe pipe))) + (lambda (file stat) + (match (stat:type stat) + ('directory #t) + ((or 'regular 'symlink) + (any (cut string-suffix? <> file) files)) + (_ #f))))) + +(define guile-without-select-bug + (package + (inherit guile-next) + (version (package-version guile-next)) + (source (origin + (method url-fetch) + (uri (string-append "ftp://alpha.gnu.org/gnu/guile/guile-" + version ".tar.xz")) + (sha256 + (base32 + "0r9y4hw17dlxahik4zsccfb2f3p2a07wqndfm251bgmam9hln6gi")) + (modules '((guix build utils))) + + ;; Remove the pre-built object files. Instead, build everything + ;; from source, at the expense of significantly longer build + ;; times (almost 3 hours on a 4-core Intel i5). + (snippet '(for-each delete-file + (find-files "prebuilt" "\\.go$"))) + + ;; Here's what we're adding + (patches (list (string-append %source-dir + "/build-aux/patch-guile-fix-live-repl.patch"))))))) + +(package + (name "guile-mudsync") + (version "git") + (source (local-file %source-dir #:recursive? #t #:select? git-file?)) + (build-system gnu-build-system) + (native-inputs `(("autoconf" ,autoconf) + ("automake" ,automake) + ("guile" ,guile-without-select-bug) + ("guile-8sync" ,guile-8sync) + ("guile-irregex" ,guile-irregex) + ("pkg-config" ,pkg-config) + ("texinfo" ,texinfo))) + (arguments + `(#:phases (modify-phases %standard-phases + (add-before 'configure 'bootstrap + (lambda _ + (zero? (system* "./bootstrap.sh")))) + (add-before 'configure 'setenv + (lambda _ + (setenv "GUILE_AUTO_COMPILE" "0")))))) + (home-page "https://notabug.org/cwebber/mudsync/") + (synopsis "Live hackable MUD system") + (description + "GNU 8sync (pronounced \"eight-sync\") is an asynchronous programming +library for GNU Guile based on the actor model.") + (license gpl3+)) -- 2.31.1