bug#29258: web client fails on https
Amirouche Boubekki writes: > GNU Guile 2.2.2 > Copyright (C) 1995-2017 Free Software Foundation, Inc. > > Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'. > This program is free software, and you are welcome to redistribute it > under certain conditions; type `,show c' for details. > > Enter `,help' for help. > scheme@(guile-user)> (use-modules (web client)) > scheme@(guile-user)> (http-get "https://www.gnu.org";) > ERROR: In procedure get-bytevector-n: > ERROR: Throw to key `gnutls-error' with args `(# connexion TLS nâa pas été terminée correctement.> > read_from_session_record_port)'. > > Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue. > scheme@(guile-user) [1]> > > scheme@(guile-user)> (use-modules (gnutls)) > scheme@(guile-user)> (gnutls-version) > $1 = "3.5.13" This is fixed in git master of guile, if it's the same bug I think it is.
bug#19180: Weak tables harmful to GC?
Ludovic Courtès writes: > Christopher Allan Webber skribis: > >> Ludovic Courtès writes: >> >>> Also, it no longer displays the pathological behavior shown in >>> <https://bugs.gnu.org/28590>. >>> >>> Of course, even better if people could test the two patches and confirm >>> that it works for them. >>> >>> Then if there are no objections I’d like to merge them in ‘stable-2.2’. >> >> Sounds great indeed, but it didn't apply to master or stable-2.2 for me? > > Really? The two patches should apply to stable-2.2, though you need to > apply them in the right order (I have it applied over > 80696023620eae12f9b2f167aee834f632a32739.) > > Ludo’. Huh? What object is this? I don't see it in my git repo. This is the latest commit I see to stable-2.2, which is also what Savannah sees: https://git.savannah.gnu.org/cgit/guile.git/commit/?h=stable-2.2&id=a74d4ee4f6e062ff640f2532c9cfc9977bb68a49
bug#27536: Add SRFI 71.
Hello!
SRFI 71 has a pretty cool syntax for assigning multiple values, and I
wanted to use it! So here it is, ported to Guile.
I've already assigned Guile copyright papers, as you probably know.
From 373aad0f4ee6bde7e34f8b6b74c85be132df108b Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber
Date: Thu, 29 Jun 2017 17:19:06 -0500
Subject: [PATCH] Add SRFI 71: Extended LET-syntax for multiple values.
* module/srfi/srfi-71.scm: New file.
* module/srfi/Makefile.am: Add it.
* doc/ref/srfi-modules.texi: Document it.
* NEWS: Update.
---
NEWS | 6 ++
doc/ref/srfi-modules.texi | 20
module/srfi/Makefile.am | 3 +-
module/srfi/srfi-71.scm | 265 ++
4 files changed, 293 insertions(+), 1 deletion(-)
create mode 100644 module/srfi/srfi-71.scm
diff --git a/NEWS b/NEWS
index 7ce583b9b..ee059fb79 100644
--- a/NEWS
+++ b/NEWS
@@ -17,6 +17,12 @@ The URI standard, RFC 3986, defines additional "relative-ref" and
for these URI subtypes has been improved. See "Universal Resource
Identifiers" in the manual, for more.
+** SRFI-71 (Extended LET-syntax for multiple values)
+
+Guile now includes SRFI-71, which extends let, let*, and letrec to
+support assigning multiple values. See "SRFI-71" in the manual for
+details.
+
* New deprecations
** Using `uri?' as a predicate on relative-refs deprecated
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 3d4415629..4527bebdc 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -58,6 +58,7 @@ get the relevant SRFI documents from the SRFI home page
* SRFI-64:: A Scheme API for test suites.
* SRFI-67:: Compare procedures
* SRFI-69:: Basic hash tables.
+* SRFI-71:: Extended LET-syntax for multiple values.
* SRFI-87:: => in case clauses.
* SRFI-88:: Keyword objects.
* SRFI-98:: Accessing environment variables.
@@ -5211,6 +5212,25 @@ specification of SRFI-64}.
See @uref{http://srfi.schemers.org/srfi-67/srfi-67.html, the
specification of SRFI-67}.
+@node SRFI-71
+@subsection SRFI-71 - Extended LET-syntax for multiple values
+@cindex SRFI-71
+
+This SRFI shadows the forms for @code{let}, @code{let*}, and @code{letrec}
+so that they may accept multiple values. For example:
+
+@example
+(use-modules (srfi srfi-71))
+
+(let* ((x y (values 1 2))
+ (z (+ x y)))
+ (* z 2))
+@result{} 6
+@end example
+
+See @uref{http://srfi.schemers.org/srfi-71/srfi-71.html, the
+specification of SRFI-71}.
+
@node SRFI-69
@subsection SRFI-69 - Basic hash tables
@cindex SRFI-69
diff --git a/module/srfi/Makefile.am b/module/srfi/Makefile.am
index 7cbac6630..8b7e965c5 100644
--- a/module/srfi/Makefile.am
+++ b/module/srfi/Makefile.am
@@ -1,6 +1,6 @@
## Process this file with automake to produce Makefile.in.
##
-## Copyright (C) 2000, 2004, 2006, 2008 Free Software Foundation, Inc.
+## Copyright (C) 2000, 2004, 2006, 2008, 2017 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -44,6 +44,7 @@ SOURCES = \
srfi-39.scm \
srfi-60.scm \
srfi-69.scm \
+ srfi-71.scm \
srfi-88.scm
# Will poke this later.
diff --git a/module/srfi/srfi-71.scm b/module/srfi/srfi-71.scm
new file mode 100644
index 0..8e8f4c77e
--- /dev/null
+++ b/module/srfi/srfi-71.scm
@@ -0,0 +1,265 @@
+;; Copyright (c) 2005 Sebastian Egner.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the
+;; ``Software''), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included
+;; in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+;; Reference implementation of SRFI-71 using PLT 208's modules
+;; sebastian.eg...@philips.com, 2005-04-29
+;;
+;; Adjusted for Guile module system by
+;; Christopher Allan Webber , 2017-06-29
+
+(define-module (srfi srfi-71)
+ #:export (uncons unlist unvector values->list
+
bug#26662: Setting break on find-tail breaks the repl
Setting a break on find-tail breaks everything at the repl: scheme@(guile-user)> ,break find-tail Trap 2: Breakpoint at #. scheme@(guile-user)> (+ 1 2 3) system/vm/traps.scm:127:31: system/vm/traps.scm:127:31: In procedure <: Wrong type: #f Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue. scheme@(guile-user) [1]> ,bt In system/repl/repl.scm: 158:22 3 (_) In unknown file: 2 (_) In system/vm/traps.scm: 141:10 1 (apply-hook #) 127:31 0 (_ _) scheme@(guile-user) [1]> Not sure why, doesn't seem to happen with some other methods I've tried... doesn't happen with map for instance. I do have a patch, though I don't entirely understand what's going on. Here's the relevant snippet of code: (define (frame-matcher proc) ;; [...] (let ((start (program-code proc)) (end (program-last-ip proc))) (lambda (frame) (let ((ip (frame-instruction-pointer frame))) (and start end (<= start ip) (< ip end)) For some reason, `end' was #f in this scenario, which is how things broke. Well, patch attached! >From 6bd0e814801d17df04ef23480647792480c08c26 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Tue, 25 Apr 2017 22:28:09 -0500 Subject: [PATCH] Fix frame-matcher for when nothing is found for program-last-ip. * module/system/vm/traps.scm (frame-matcher): Check for end before we compare it to anything, since it might be #f. --- module/system/vm/traps.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm index c4861c925..43a067a76 100644 --- a/module/system/vm/traps.scm +++ b/module/system/vm/traps.scm @@ -124,7 +124,7 @@ (end (program-last-ip proc))) (lambda (frame) (let ((ip (frame-instruction-pointer frame))) -(and (<= start ip) (< ip end)) +(and end (<= start ip) (< ip end)) ((struct? proc) (frame-matcher (procedure proc))) (else -- 2.12.2
bug#23043: breakpoints not honoured by guile master
I think that this was related to an earlier bug where the traps weren't being tripped at all, which has been fixed (trace also wasn't working). If I'm wrong, please reopen!
bug#24818: Clean up socket files set up by --listen=/path/to/socket-file
Andy Wingo writes: > I agree :) Thanks for the patch! > > The patch goes in a direction that I'm a bit hesitant about though -- > this command-line processing is getting a bit intense. Would it be > possible to add a #:cleanup? argument to the spawn-server function > instead? I agree that my previous patch makes things more complicated, so I tried the route you suggested, but... > My only doubt would be whether all threads unwind when the program > ends. (And if they don't, is that a bug? I am not sure but I would > guess so; dunno.) ... and it doesn't seem to work for that reason. The thread never seems to unwind. I put a print statement (not in this patch) at the very part of the out guard but it never seems to run. Too bad... So I guess the question is whether or not addressing the thread issue as a potential bug should be done or applying the previous patch version which worked but made the command line processing more complex? Or something else? From 79ab483a872638abe311c521c3467c060566b39c Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Wed, 8 Mar 2017 12:04:55 -0600 Subject: [PATCH] Clean up socket file set up by --listen [Unfortunately, this patch does not work because the thread doesn't seem to unwind. Submitted for demonstrative purposes, or in the hope that could be fixed.] * module/ice-9/command-line.scm (compile-shell-switches): * module/system/repl/server.scm (run-server, run-server*, spawn-server): Clean up socket file set up by --listen on exit, if it exists. --- module/ice-9/command-line.scm | 3 ++- module/system/repl/server.scm | 44 +++ 2 files changed, 30 insertions(+), 17 deletions(-) diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm index 98d385569..3305c671d 100644 --- a/module/ice-9/command-line.scm +++ b/module/ice-9/command-line.scm @@ -388,7 +388,8 @@ If FILE begins with `-' the -s switch is mandatory. (error "invalid port for --listen" ((string-prefix? "/" where) ; --listen=/PATH/TO/SOCKET `((@@ (system repl server) spawn-server) -((@@ (system repl server) make-unix-domain-server-socket) #:path ,where))) +((@@ (system repl server) make-unix-domain-server-socket) #:path ,where) +#:cleanup? #t)) (else (error "unknown argument to --listen" out))) diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm index 725eb4eda..1ced8e8d1 100644 --- a/module/system/repl/server.scm +++ b/module/system/repl/server.scm @@ -21,6 +21,7 @@ (define-module (system repl server) #:use-module (system repl repl) + #:use-module (ice-9 and-let-star) #:use-module (ice-9 threads) #:use-module (ice-9 rdelim) #:use-module (ice-9 match) @@ -84,11 +85,12 @@ (bind sock AF_UNIX path) sock)) -(define* (run-server #:optional (server-socket (make-tcp-server-socket))) - (run-server* server-socket serve-client)) +(define* (run-server #:optional (server-socket (make-tcp-server-socket)) + #:key (cleanup? #f)) + (run-server* server-socket serve-client #:cleanup? cleanup?)) ;; Note: although not exported, this is used by (system repl coop-server) -(define (run-server* server-socket serve-client) +(define* (run-server* server-socket serve-client #:key (cleanup? #f)) ;; We use a pipe to notify the server when it should shut down. (define shutdown-pipes (pipe)) (define shutdown-read-pipe (car shutdown-pipes)) @@ -122,19 +124,29 @@ (sigaction SIGPIPE SIG_IGN) (add-open-socket! server-socket shutdown-server) (listen server-socket 5) - (let lp () -(match (accept-new-client) - (#f - ;; If client is false, we are shutting down. - (close shutdown-write-pipe) - (close shutdown-read-pipe) - (close server-socket)) - ((client-socket . client-addr) - (make-thread serve-client client-socket client-addr) - (lp) - -(define* (spawn-server #:optional (server-socket (make-tcp-server-socket))) - (make-thread run-server server-socket)) + (dynamic-wind +(const #f) +(lambda () + (let lp () +(match (accept-new-client) + (#f + ;; If client is false, we are shutting down. + (close shutdown-write-pipe) + (close shutdown-read-pipe) + (close server-socket)) + ((client-socket . client-addr) + (make-thread serve-client client-socket client-addr) + (lp) +(lambda () + (and-let* (cleanup? + (sa (getsockname server-socket)) + (path (sockaddr:path sa)) + ((file-exists? path))) +(delete-file path) + +(define* (spawn-server #:optional (server-socket (make-tcp-server-socket)) +
bug#25481: `guile --listen' broken on guile master
(originally accidentally sent to guile-devel instead of here, sorry for xpost!) If you use the latest Guile, you'll find that "guile --listen" has broken. If you try: ./meta/guile --listen=/tmp/guile-socket then you'll find that you have a very short window in which you can do: M-x geiser-connect-local guile /tmp/guile-socket but then the main repl, the one you launched in the shell, hangs. And if you wait too long or disconnect then reconnect, you won't be able to connect again. What you'll see in the guile process is this: scheme@(guile-user)> In thread: ERROR: In procedure select: Interrupted system call Here's the commit that introduces the bug: 206dced87f425af7eed628530313067a45bee2c2 I've verified that it works right before that commit. The commit does some things involving changing the code involving the "select" and etc in the repl code, so maybe that's related.
bug#25300: Trap infrastructure broken in Guile 2.2?
Guile 2.0.13: scheme@(guile-user)> (define (foo n) (if (= n 0) 'done (foo (1- n scheme@(guile-user)> ,tracepoint foo Trap 0: Tracepoint at #. scheme@(guile-user)> (foo 5) Trap 0: (foo 5) Trap 0: | (foo 4) Trap 0: | | (foo 3) Trap 0: | | | (foo 2) Trap 0: | | | | (foo 1) Trap 0: | | | | | (foo 0) Trap 0: | | | | | done Trap 0: | | | | done Trap 0: | | | done Trap 0: | | done Trap 0: | done Trap 0: done $2 = done scheme@(guile-user)> Guile 2.1.5 (via guile-next in guix): scheme@(guile-user)> (define (foo n) (if (= n 0) 'done (foo (1- n ... ... ... scheme@(guile-user)> scheme@(guile-user)> ,tracepoint foo Trap 0: Tracepoint at #. scheme@(guile-user)> (foo 30) $1 = done Likewise, ,break and etc do not work for me.
bug#25211: GOOPS #:class alocation broken in Guile 2.2
In Guile 2.2:
(define-class ()
(bar #:allocation #:class
#:init-value 'baz))
(slot-definition-allocation (class-slot-definition 'bar))
=> #:instance
In Guile 2.0 this properly returns #:class.
Also, curiously, Guile 2.2 breaks if you present the keywords in the
wrong order:
(define-class ()
(bar #:allocation #:class
#:init-value 'baz))
oop/goops.scm:352:0: In procedure class-precedence-list:
oop/goops.scm:352:0: In procedure struct_vtable: Wrong type argument in
position 1 (expecting struct): #:init-value
Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue.
scheme@(#{8sync}# systems actors) [1]> ,bt
In current input:
1205:0 4 (_)
In oop/goops.scm:
2978:4 3 (_ _ . _)
811:17 2 (%prep-layout! #< 30b1b40>)
767:19 1 (%compute-layout _ 0 #f)
352:0 0 (class-precedence-list _)
I'm guessing that's related!
bug#24075: tls/https support in Guile (through r6rs binary ports?)
Ludovic Courtès writes:
> I think ‘ensure-gnutls’ would be exactly as in this patch, and the
> autoload hack would be exactly as shown above.
Got it! Done...
> @xref generates a “See” for the beginning of a sentence, so it should
> be:
>
> … support. @xref{…}, for more information.
... and done!
> Also, “HTTPS” and “GnuTLS”. :-)
Ooops, misssed that bit in the first commit which I had pushed, so I
made two commits. :)
> The rest is all good for me, so the only remaining bits are the autoload
> thing and maybe the bug you observed?
Yep! It's now done... as of 8f1db9f we now have HTTPS support
out-of-the-box in Guile! Party time!
bug#24075: tls/https support in Guile (through r6rs binary ports?)
Ludovic Courtès writes: > Christopher Allan Webber skribis: > >> First of all, the response body starts in the wrong place... it should >> start with "". Then, somewhere in the middle it switches >> to garbage output. I'm not sure why. > > [...] > >> +(let ((record ((gnutls-ref 'session-record-port) session))) >> + (define (read! bv start count) >> +(define read-bv (get-bytevector-n record count)) >> +(if (eof-object? read-bv) >> +0 ; read! returns 0 on eof-object >> +(let ((read-bv-len (bytevector-length read-bv))) >> + (bytevector-copy! read-bv 0 bv 0 read-bv-len) >> + read-bv-len))) > > Looks like ‘start’ is ignored here. Could that be the reason? > > Ludo’. ... that was absolutely it. What an omission on my part! Thanks for catching it. :)
bug#24075: tls/https support in Guile (through r6rs binary ports?)
Some less good news: I found out that the https stuff is not working
right for all sites. I tested though... the code works *before* I
wrapped it in custom-binary-input/output-port.
After being wrapped though, strange things happen. For some sites (eg
"https://webmention.net/";) things seem fine:
scheme@(guile-user)> (http-get (string->uri "https://webmention.net/";))
$7 = #< version: (1 . 1) code: 200 reason-phrase: "OK" headers:
((server . "nginx/1.9.10") (date . #) (content-type text/html
(charset . "UTF-8")) (transfer-encoding (chunked)) (connection close)
(x-powered-by . "PHP/5.6.21-1+donate.sury.org~trusty+4")) port: #>
$8 = "\n\n\n Webmention\n \n\n\n\n\n \n Webmention\n \n Webmention is a simple way to notify any URL when you link
to it from your site.\n \n \nThe Webmention
specification is being developed under the https://www.w3.org/wiki/Socialwg\";>W3C Social Web Working
Group.\nhttps://www.w3.org/TR/webmention/\";>Latest published version\n
http://webmention.net/draft/\";>Latest editor's
draft\nhttp://webmention.net/implementations/\";>Implementations\n
The specification was contributed to the W3C by the IndieWeb community.
More information and history of the spec can be found on the https://indieweb.org/webmention\";>IndieWeb wiki.\n \n
\n\n\n\n"
For other sites, especially ones where the pages are larger, things are
broken. For example, let's try to pull down the site of friend Joey
Hess:
scheme@(guile-user)> (http-get (string->uri "https://joeyh.name/";))
$9 = #< version: (1 . 1) code: 200 reason-phrase: "OK" headers:
((date . #) (server . "Apache/2.4.10 (Debian)") (last-modified
. #) (etag "195c-53f9d4af683f3" . #t) (accept-ranges bytes)
(content-length . 6492) (vary accept-encoding) (cache-control (max-age . 0))
(expires . #) (connection close) (content-type text/html)) port:
#>
$10 = "moz-background-size: cover;\n-o-background-size: cover;\n
background-size: cover;\n}\n.sidebar {\nbackground: none;\nborder:
none;\n}\ninput#searchbox {\ndisplay: none;\n}\n#pageinfo {\ndisplay:
none;\n}\n.pageheader .actions ul {\nborder-bottom: none;\n}\n#pagebody {\n
margin-left: 20%;\n}\n.archivepagedate {\nfont-size: 0.5em;\n}\n.actions
{\ndisplay: none;\n}\n\n\n\n\n\n\n\n\npersonal\n\nblog\npics\ncontact me\ntodo\n\n\n\n\ntechnical\n\ncode\nvcshome\ntalks\nscreencasts\ntermcasts\nrfcs\nboxen\n\n\n\n\nfun\n\nJoey Learns to
Fly\nhttp://olduse.net/\";>oldusenet\nlanguages\nyurt\ncaving\ngrep\nmeta\n\n\n\n\n\n\n\n\n\n\ninterviews\n\nhttp://joey.hess.usesthis.com\";>2012: The
Setup\n\n\"When power is low, I often hack in the
evenings by lantern light.\"\n\nhttp://zgrimshell.github.io/posts/interviews-with-floss-developers-joey-hess.html\";>2015:
Life after Debian\n\n\"I want to build worthwhile
things that might last.\"\n\nhttp://lwn.net/Articles/672352/\";>2016: Linux Weekly
News\n\n\"I still see myself as a beginner, and
certainly not an
exemplar.\"\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\nLast edited
mid-morning Monday, March 2nd, 2015\n\n\n\n\n\n\n\n\n\n\n\n\n\n\" title=\"Thu, 22 Sep 2016
16:13:21 -0400\">at teatime on Thursday, September 22nd,
2016\n\n\n\n\n\nPoW bucket bloom: throttling anonymous
clients with proof of work, token buckets, and bloom filters\n\n\nPosted late Monday night, September 13th, 2016\n\n\n\n\n\nlate
summer\n\n\nPosted late Tuesday evening, August 30th,
2016\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n
bug#24075: tls/https support in Guile (through r6rs binary ports?)
ithin the
with-https-proxy?
> Otherwise works for me!
>
> Could you document HTTPS support in the doc of ‘open-socket-for-uri’
> (info "(guile) Web Client")? Probably with something like:
>
> @xref{Guile Preparations,
> how to install the GnuTLS bindings for Guile,, gnutls-guile,
> GnuTLS-Guile}, for more information.
Done.
> Thank you Chris!
>
> Ludo’.
Updated patch attached. Still needs advisement on the exception and
autoload bits though!
- Chris
>From 91c0a4a728ca4bf2e9468cdc849c350dd3f7380f Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber
Date: Thu, 17 Sep 2015 15:14:54 -0500
Subject: [PATCH] web: Add https support through gnutls.
Since importing gnutls directly would result in a dependency cycle,
we load gnutls lazily.
This uses code originally written for Guix by Ludovic
* module/web/client.scm: (%http-receive-buffer-size)
(warn-no-gnutls-return-false, gnutls-module, ensure-gnutls)
(gnutls-ref, tls-wrap): New variables.
(open-socket-for-uri): Wrap in tls when uri scheme is https.
* doc/ref/web.texi (open-socket-for-uri): Document gnutls usage.
---
doc/ref/web.texi | 6 +-
module/web/client.scm | 175 +++---
2 files changed, 158 insertions(+), 23 deletions(-)
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index becdc28..c2f3f61 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -1422,7 +1422,11 @@ the lower-level HTTP, request, and response modules.
@end example
@deffn {Scheme Procedure} open-socket-for-uri uri
-Return an open input/output port for a connection to URI.
+Return an open input/output port for a connection to URI. Guile
+dynamically loads gnutls for https support; for more information, see
+@xref{Guile Preparations,
+how to install the GnuTLS bindings for Guile,, gnutls-guile,
+GnuTLS-Guile}.
@end deffn
@deffn {Scheme Procedure} http-get uri arg...
diff --git a/module/web/client.scm b/module/web/client.scm
index f24a4d7..f0fba49 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -1,6 +1,6 @@
;;; Web client
-;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -43,8 +43,11 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
+ #:use-module ((rnrs io ports)
+#:prefix rnrs-ports:)
#:export (current-http-proxy
open-socket-for-uri
+open-connection-for-uri
http-get
http-get*
http-head
@@ -54,11 +57,113 @@
http-trace
http-options))
+(define %http-receive-buffer-size
+ ;; Size of the HTTP receive buffer.
+ 65536)
+
+;; Provide access to the gnutls-module, but fail gracefully if not available.
+;; Why take this route and not just straight up import the module?
+;; Guile can't depend on gnutls because gnutls includes Guile as a dependency.
+;; There's some risk of dependency cycles, so lazily resolving things only
+;; once needed helps!
+
+(define warn-no-gnutls-return-false
+ (lambda _
+(format (current-error-port)
+"warning: (gnutls) module not available\n")
+#f))
+
+(define gnutls-module
+ (delay
+(catch 'misc-error
+ (lambda ()
+(let ((module (resolve-interface '(gnutls
+ ;; In some 2.1/2.2 installations installed alongside Guile 2.0, gnutls
+ ;; can be imported but the bindings are broken as "unknown type".
+ ;; Here we check that gnutls-version is the right type (a procedure)
+ ;; to make sure the bindings are ok.
+ (if (procedure? (module-ref module 'gnutls-version))
+ module
+ (warn-no-gnutls-return-false
+ warn-no-gnutls-return-false)))
+
+(define (ensure-gnutls)
+ (if (not (force gnutls-module))
+ (throw 'gnutls-not-available "(gnutls) module not available")))
+
+(define (gnutls-ref symbol)
+ "Fetch method-symbol from the gnutls module"
+ (module-ref (force gnutls-module) symbol))
+
(define current-http-proxy
(make-parameter (let ((proxy (getenv "http_proxy")))
(and (not (equal? proxy ""))
proxy
+(define (tls-wrap port server)
+ "Return PORT wrapped in a TLS connection to SERVER. SERVER must be a DNS
+host name without trailing dot."
+ (define (log level str)
+(format (current-error-port)
+"gnutls: [~a|~a] ~a" (getpid) level str))
+
+ (ensure-gnutls)
+
+ (let ((session ((gnutls-ref 'make-session)
+ (gnutls-ref 'connection-end/client
+
+;; Some servers such as 'cloud.github.com' require th
bug#24075: tls/https support in Guile (through r6rs binary ports?)
Christopher Allan Webber writes: > Here's two patches. The first fixes some of the section names in the > r6rs-ports.test file, and can be applied to master immediately. I don't think it was captured, but these patches were applied to master. So the next thing is getting the gnutls support for https in Guile. And! I have a patch that does that! I think it's probably good enough to be merged probably at this point, but it could use review. >From d4def07779c5532ffc6b7ee13820919bc23d1811 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Thu, 17 Sep 2015 15:14:54 -0500 Subject: [PATCH] web: Add https support through gnutls. Since importing gnutls directly would result in a dependency cycle, we load gnutls lazily. This uses code originally written for Guix by Ludovic * module/web/client.scm: (%http-receive-buffer-size) (warn-no-gnutls-return-false, gnutls-module, ensure-gnutls) (gnutls-ref, tls-wrap): New variables. (open-socket-for-uri): Wrap in tls when uri scheme is https. --- module/web/client.scm | 173 +++--- 1 file changed, 151 insertions(+), 22 deletions(-) diff --git a/module/web/client.scm b/module/web/client.scm index f24a4d7..f1a6bb5 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -1,6 +1,6 @@ ;;; Web client -;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc. +;; Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016 Free Software Foundation, Inc. ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -43,8 +43,11 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) + #:use-module ((rnrs io ports) +#:prefix rnrs-ports:) #:export (current-http-proxy open-socket-for-uri +open-connection-for-uri http-get http-get* http-head @@ -54,11 +57,111 @@ http-trace http-options)) +(define %http-receive-buffer-size + ;; Size of the HTTP receive buffer. + 65536) + +;; Provide access to the gnutls-module, but fail gracefully if not available. +;; Why take this route and not just straight up import the module? +;; Guile can't depend on gnutls because gnutls includes Guile as a dependency. +;; There's some risk of dependency cycles, so lazily resolving things only +;; once needed helps! + +(define warn-no-gnutls-return-false + (lambda _ +(format (current-error-port) +"warning: (gnutls) module not available\n") +#f)) + +(define gnutls-module + (delay +(catch 'misc-error + (lambda () +(let ((module (resolve-interface '(gnutls + ;; In some 2.1/2.2 installations installed alongside Guile 2.0, gnutls + ;; can be imported but the bindings are broken as "unknown type". + ;; Here we check that gnutls-version is the right type (a procedure) + ;; to make sure the bindings are ok. + (if (procedure? (module-ref module 'gnutls-version)) + module + (warn-no-gnutls-return-false + warn-no-gnutls-return-false))) + +(define (ensure-gnutls) + (if (not (force gnutls-module)) + (throw 'gnutls-not-available "(gnutls) module not available"))) + +(define (gnutls-ref symbol) + "Fetch method-symbol from the gnutls module" + (module-ref (force gnutls-module) symbol)) + (define current-http-proxy (make-parameter (let ((proxy (getenv "http_proxy"))) (and (not (equal? proxy "")) proxy +(define (tls-wrap port server) + "Return PORT wrapped in a TLS connection to SERVER. SERVER must be a DNS +host name without trailing dot." + (define (log level str) +(format (current-error-port) +"gnutls: [~a|~a] ~a" (getpid) level str)) + + (ensure-gnutls) + + (let ((session ((gnutls-ref 'make-session) + (gnutls-ref 'connection-end/client + +;; Some servers such as 'cloud.github.com' require the client to support +;; the 'SERVER NAME' extension. However, 'set-session-server-name!' is +;; not available in older GnuTLS releases. See +;; <http://bugs.gnu.org/18526> for details. +(if (module-defined? (force gnutls-module) + 'set-session-server-name!) +((gnutls-ref 'set-session-server-name!) + session (gnutls-ref 'server-name-type/dns) server) +(format (current-error-port) +"warning: TLS 'SERVER NAME' extension not supported~%")) + +((gnutls-ref 'set-session-transport-fd!) session (fileno port)) +((gnutls-ref 'set-session-default-priority!) session) + +;; The "%COMPAT" bit
bug#24852: guile --listen=/path/to/socket: "ERROR: In procedure select: Interrupted system call"
Christopher Allan Webber writes: > Well, I was wrong. For some reason this stopped working for me over the > last couple of days, but it doesn't seem to be Guile master that's at > fault. I'm having the same trouble with Guile 2.0. > > Not sure how this started happening or why it's happening though... I figured out why I was experiencing this issue. It was a user issue... sort of. The behavior *is* reproducible but it wasn't a newly introduced bug (though it may be a bug). The difference between Guile stable and master experiencing the bug: I hadn't compiled Guile master with readline, so I disabled readline support in my ~/.guile file. Thus, the behavior "mysteriously" also started hapening in stable as well after this. Once I re-enabled it, the problem went away. So I guess hooking up readline somehow prevents this blocking prompt, though why, don't know!
bug#24852: guile --listen=/path/to/socket: "ERROR: In procedure select: Interrupted system call"
Well, I was wrong. For some reason this stopped working for me over the last couple of days, but it doesn't seem to be Guile master that's at fault. I'm having the same trouble with Guile 2.0. Not sure how this started happening or why it's happening though...
bug#24852: guile --listen=/path/to/socket: "ERROR: In procedure select: Interrupted system call"
Build Guile master, then do: ./meta/guile --listen=/tmp/guile-socket Connect from emacs like so: M-x guile-connect-local You'll connect, but if you look at the shell you spawned Guile in, you'll see: ERROR: In procedure select: Interrupted system call You'll also find that where you would expect to have a working REPL, it's now blocked, and does not appear to become unblocked even after exiting the connected REPL. You also won't be able to spawn a second REPL via `guile-connect-local'. This doesn't happen in Guile's 2.0.X stable releases, only in latest master afaict. I wonder if it has something to do with recent changes in the way ports suspend?
bug#24818: Clean up socket files set up by --listen=/path/to/socket-file
In light of the recent security vulnerability on using localhost + port, I've been using socket files for live hacking. Unfortunately, these socket files stay around after closing guile, which means this can happen: $ guile --listen=/tmp/guile-socket scheme@(guile-user)> ,q $ guile --listen=/tmp/guile-socket ERROR: In procedure bind: ERROR: In procedure bind: Address already in use That's not very nice! I really don't like having to clean up these files by hand Guile should do it for me. Fortunately, here's a patch that does just that! It uses dynamic-wind and cleans up the socket file, if it exists. (But it doesn't break if it doesn't!) From 12a1c24890448ec9a2d33cabff7f70f6332dbb4f Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 29 Oct 2016 11:28:05 -0500 Subject: [PATCH] Clean up socket file set up by --listen * module/ice-9/command-line.scm (compile-shell-switches): Clean up socket file set up by --listen on exit, if it exists. --- module/ice-9/command-line.scm | 80 --- 1 file changed, 44 insertions(+), 36 deletions(-) diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm index 98d3855..cdc5427 100644 --- a/module/ice-9/command-line.scm +++ b/module/ice-9/command-line.scm @@ -199,6 +199,7 @@ If FILE begins with `-' the -s switch is mandatory. (user-load-compiled-path '()) (user-extensions '()) (interactive? #t) +(clean-socket-file #f) (inhibit-user-init? #f) (turn-on-debugging? #f) (turn-off-debugging? #f)) @@ -387,6 +388,7 @@ If FILE begins with `-' the -s switch is mandatory. ((@@ (system repl server) make-tcp-server-socket) #:port ,port)) (error "invalid port for --listen" ((string-prefix? "/" where) ; --listen=/PATH/TO/SOCKET + (set! clean-socket-file where) `((@@ (system repl server) spawn-server) ((@@ (system repl server) make-unix-domain-server-socket) #:path ,where))) (else @@ -430,42 +432,48 @@ If FILE begins with `-' the -s switch is mandatory. `(;; It would be nice not to load up (ice-9 control), but the ;; default-prompt-handler is nontrivial. (@ (ice-9 control) %) -(begin - ;; If we didn't end with a -c or a -s and didn't supply a -q, load - ;; the user's customization file. - ,@(if (and interactive? (not inhibit-user-init?)) -'((load-user-init)) -'()) - - ;; Use-specified extensions. - ,@(map (lambda (ext) - `(set! %load-extensions (cons ,ext %load-extensions))) - user-extensions) - - ;; Add the user-specified load paths here, so they won't be in - ;; effect during the loading of the user's customization file. - ,@(map (lambda (path) - `(set! %load-path (cons ,path %load-path))) - user-load-path) - ,@(map (lambda (path) - `(set! %load-compiled-path - (cons ,path %load-compiled-path))) - user-load-compiled-path) - - ;; Put accumulated actions in their correct order. - ,@(reverse! out) - - ;; Handle the `-e' switch, if it was specified. - ,@(if entry-point -`((,entry-point (command-line))) -'()) - ,(if interactive? - ;; If we didn't end with a -c or a -s, start the - ;; repl. - '((@ (ice-9 top-repl) top-repl)) - ;; Otherwise, after doing all the other actions - ;; prescribed by the command line, quit. - '(quit) +(dynamic-wind + (const #f) ; no-op + (lambda () +;; If we didn't end with a -c or a -s and didn't supply a -q, load +;; the user's customization file. +,@(if (and interactive? (not inhibit-user-init?)) + '((load-user-init)) + '()) + +;; Use-specified extensions. +,@(map (lambda (ext) + `(set! %load-extensions (cons ,ext %load-extensions))) + user-extensions) + +;; Add the user-specified load paths here, so they won't be in +;; effect during the loading of the user's customization file. +,@(map (lambda (path) + `(set! %load-path (cons ,path %load-path))) + user-load-path) +,@(map (lambda (path) + `(set! %load-compiled-path +(cons ,path %load-compiled-path))) +
bug#24075: tls/https support in Guile (through r6rs binary ports?)
Andy Wingo writes:
> On Tue 26 Jul 2016 17:55, Christopher Allan Webber
> writes:
>
>> I've been told on IRC that the "right solution" is to add r6rs style
>> binary ports:
>>
>> http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-9.html
>>
>> So maybe that's what should be done?
>
> I did this :) Missing some tests though and indeed completely
> untested. Please give it a go then we can see about implementing TLS
> ports on top of that.
>
> Andy
Here's two patches. The first fixes some of the section names in the
r6rs-ports.test file, and can be applied to master immediately.
The second patch is the tests. I ported tests in the most naive way
possible: copy/pasting the custom-binary-input-port and
custom-binary-output-port tests and adjusting for the
custom-binary-input/output-port. It's not ideal, a bit spaghetti'ish,
but maybe that's okay? I'm not sure.
However, two are not working: one fails and one errors, with the
following:
FAIL: r6rs-ports.test: 8.2.13 Input/output ports: custom binary input/output
port supports `port-position', not `set-port-position!' - arguments:
(expected-value 42 actual-value #f)
ERROR: r6rs-ports.test: 8.2.13 Input/output ports: custom binary input/output
port unbuffered & 'port-position' - arguments: ((misc-error "seek" "port is not
seekable" (#) #f))
I'm not sure if this is an error on my side, features not supported by
the new ports, or legitimate test failures.
I'll try to do more research, but if someone who's more knowledgable
knows what's going on, maybe that would speed things up.
- Chris
>From 1f9d6ea0ae18557789c39342d04aec33d2156207 Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber
Date: Thu, 11 Aug 2016 17:06:10 -0500
Subject: [PATCH 1/2] Correct section number for "Input Ports" tests.
* test-suite/tests/r6rs-ports.test: Correct "Input Ports" section heading
from "7.2.7" -> "8.2.7", "7.2.5" -> "8.2.5", "7.2.8" -> "8.2.8",
and "7.2.11" -> "8.2.11".
---
test-suite/tests/r6rs-ports.test | 8
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index b3f11bb..9aa605b 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -74,7 +74,7 @@
receiver
-(with-test-prefix "7.2.5 End-of-File Object"
+(with-test-prefix "8.2.5 End-of-File Object"
(pass-if "eof-object"
(and (eqv? (eof-object) (eof-object))
@@ -84,7 +84,7 @@
(port-eof? (open-input-string ""
-(with-test-prefix "7.2.8 Binary Input"
+(with-test-prefix "8.2.8 Binary Input"
(pass-if "get-u8"
(let ((port (open-input-string "A")))
@@ -236,7 +236,7 @@
(lambda () #t)) ;; close-port
"rw")))
-(with-test-prefix "7.2.11 Binary Output"
+(with-test-prefix "8.2.11 Binary Output"
(pass-if "put-u8"
(let ((port (make-soft-output-port)))
@@ -328,7 +328,7 @@
(delete-file filename))
-(with-test-prefix "7.2.7 Input Ports"
+(with-test-prefix "8.2.7 Input Ports"
(with-test-prefix "open-file-input-port"
(test-input-file-opener open-file-input-port (test-file)))
--
2.9.2
>From 297dc06f1bfbb49f636018944f0a1c114d6778ea Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber
Date: Sat, 20 Aug 2016 16:20:53 -0500
Subject: [PATCH 2/2] Add tests for make-custom-binary-input/output-port
* test-suite/tests/r6rs-ports.test ("8.2.13 Input/output ports"):
Add tests for custom binary input/output ports, copied from
existing binary input and binary output tests.
---
test-suite/tests/r6rs-ports.test | 383 ++-
1 file changed, 382 insertions(+), 1 deletion(-)
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 9aa605b..94d9fc0 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -1059,11 +1059,392 @@ not `set-port-position!'"
values))
(delete-file filename)))
+;; Used for a lot of the make-custom-input/output tests to stub out
+;; the read/write section for whatever part we're ignoring
+(define dummy-write! (const 0))
+(define dummy-read! (const 0))
+
(with-test-prefix "8.2.13 Input/output ports"
(with-test-prefix "open-file-input/output-port [output]"
(test-output-file-opener open-file-input/output-port (test-file)))
(with-test-prefix "open-file-input/output-port [input]"
-(test-input-file-opener open-file-input/output-port (test-file
+(test-input-file-opener op
bug#24207: Fixing documentation example for make-custom-binary-input-port
The example previously did not run, because it was missing the "closed"
parameter. Fixed.
>From abed180e8ea3ada5c4e156165f0b5e648d517ba2 Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber
Date: Thu, 11 Aug 2016 15:10:19 -0500
Subject: [PATCH] Fix example in make-custom-binary-input-port documentation
* doc/ref/api-io.texi (Custom Ports): Add additional argument to example's
invocation of make-custom-binary-input-port. Previously had mismatched arity
by missing "closed" argument.
---
doc/ref/api-io.texi | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 76c8db8..e4e4f36 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1,7 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009,
-@c 2010, 2011, 2013 Free Software Foundation, Inc.
+@c 2010, 2011, 2013, 2016 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node Input and Output
@@ -1278,8 +1278,8 @@ procedure (@pxref{Bytevector Ports}) could be implemented as follows:
(set! position new-position))
(make-custom-binary-input-port "the port" read!
- get-position
- set-position!))
+ get-position set-position!
+ #f))
(read (open-bytevector-input-port (string->utf8 "hello")))
@result{} hello
--
2.9.2
bug#24075: tls/https support in Guile (through r6rs binary ports?)
Guile lacks https support by default, which is a really glaring omission in any modern language! I've submitted some code adapted from Guix previously as a step towards adding https support: https://lists.gnu.org/archive/html/guile-devel/2015-09/msg00031.html While it can be pulled off through some gnutls hacks, these have problems. Unfortunately, it seems that the file descriptor is leaked: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=20145 I've been told on IRC that the "right solution" is to add r6rs style binary ports: http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-9.html So maybe that's what should be done? Anyway, I think this is one of *the most important things* that Guile currently lacks. (It's held me back from considering Guile as a serious choice for at least one project, myself!) Hope it can be fixed! - Chris
bug#23435: The solution to the mysterious SIGABRT
So with some help from Andy Wingo (thanks Andy!) I figured out what to do. What happened is that when code in the resumed delimited continuation threw an error, it attempted to find the original catch's prompt, which had disappeared. Remember that I had a prompt in a prompt, so the outer prompt's catch had gone away. The trick was to put a catch around the inner prompt as well, repeating the same handlers given to the outer prompt. Not sure how coherent that is, but this fixed it. Thanks, Andy!
bug#23435: Mysterious SIGABRT
In the actor model subsystem I have in 8sync things are a bit tricky... I have a prompt layered on a prompt, and beyond the first prompt is a catch-all that prevents the event loop from crashing things (it just prints the error and continues). However, there's a circumstance where if I abort to a prompt on the inner prompt, store the delimited continuation until I'm ready to resume it again, resume it, and then within the thing I resume, raise *any sort of error*... well, I get a SIGABRT. Some things of note: - If I don't try to catch the error outside of the prompt, I don't get a SIGABRT. I can catch it within the second prompt and it's fine. - The pre-unwind-handler still works fine. I haven't been able to figure out how to make a more minimalist example, but this happens consistently, and makes it so my async programs grind to a halt in a way I would prefer they didn't (part of the goal of the actor model is that it's friendly towards some actors erroring out, in theory...) Running gdb on the core gives me the following: Thread 4 (Thread 0x7f504bfff700 (LWP 11900)): #0 0x7f505312efcd in read () from /gnu/store/8m00x5x8ykmar27s9248cmhnkdb2n54a-glibc-2.22/lib/libpthread.so.0 #1 0x7f5053661997 in read_signal_pipe_data () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #2 0x7f505335d093 in GC_do_blocking_inner () from /gnu/store/my4az71gz8iqd4w8kb34kq7vlk3fcvhm-libgc-7.4.2/lib/libgc.so.1 #3 0x7f505335194c in GC_with_callee_saves_pushed () from /gnu/store/my4az71gz8iqd4w8kb34kq7vlk3fcvhm-libgc-7.4.2/lib/libgc.so.1 #4 0x7f505335742c in GC_do_blocking () from /gnu/store/my4az71gz8iqd4w8kb34kq7vlk3fcvhm-libgc-7.4.2/lib/libgc.so.1 #5 0x7f505368422a in scm_without_guile () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #6 0x7f50536618ff in signal_delivery_thread () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #7 0x7f5053697335 in vm_debug_engine () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #8 0x7f505361035e in scm_call_3 () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #9 0x7f505368657e in scm_internal_catch () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #10 0x7f505368466c in really_spawn () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #11 0x7f50536069ca in c_body () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #12 0x7f5053697335 in vm_debug_engine () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #13 0x7f50536103a3 in scm_call_4 () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #14 0x7f5053607141 in scm_i_with_continuation_barrier () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #15 0x7f50536071d5 in scm_c_with_continuation_barrier () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #16 0x7f5053683dcc in with_guile_and_parent () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #17 0x7f50533573f2 in GC_call_with_stack_base () from /gnu/store/my4az71gz8iqd4w8kb34kq7vlk3fcvhm-libgc-7.4.2/lib/libgc.so.1 #18 0x7f50536837dc in spawn_thread () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #19 0x7f505335c34e in GC_inner_start_routine () from /gnu/store/my4az71gz8iqd4w8kb34kq7vlk3fcvhm-libgc-7.4.2/lib/libgc.so.1 #20 0x7f50533573f2 in GC_call_with_stack_base () from /gnu/store/my4az71gz8iqd4w8kb34kq7vlk3fcvhm-libgc-7.4.2/lib/libgc.so.1 #21 0x7f5053126464 in start_thread () from /gnu/store/8m00x5x8ykmar27s9248cmhnkdb2n54a-glibc-2.22/lib/libpthread.so.0 #22 0x7f5051b005cd in clone () from /gnu/store/8m00x5x8ykmar27s9248cmhnkdb2n54a-glibc-2.22/lib/libc.so.6 Thread 3 (Thread 0x7f505080d700 (LWP 11899)): #0 0x7f5051af9313 in select () from /gnu/store/8m00x5x8ykmar27s9248cmhnkdb2n54a-glibc-2.22/lib/libc.so.6 #1 0x7f5053616c93 in scm_select () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #2 0x7f505369678f in vm_debug_engine () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #3 0x7f505361035e in scm_call_3 () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #4 0x7f50536845c5 in really_launch () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #5 0x7f50536069ca in c_body () from /gnu/store/hyk2i7b8mwbrbiyqk5sgrfgds9zvcrn5-guile-2.0.11/lib/libguile-2.0.so.22 #6 0x7f5053697335 in vm_debug_engine ()
bug#23404: Infinite recursion in GOOPS in Guile 2.2
It looks like my example was incomplete. It turns out loading and passing in an srfi-9 record is critical to instantiating the bug. Why? I'm not sure... (use-modules (oop goops) (srfi srfi-9)) (define-class ()) (define-record-type (make-some-record foo) some-record? (foo some-record-foo)) (define-method (time-to-break (some-class ) not-a-class) (display "We're never going home are we?\n")) ;; Now it'll break (time-to-break (make ) (make-some-record 1))
bug#23404: Infinite recursion in GOOPS in Guile 2.2
It looks like my example was incomplete. It turns out loading and passing in an srfi-9 record is critical to instantiating the bug. Why? I'm not sure... (use-modules (oop goops) (srfi srfi-9)) (define-class ()) (define-record-type (make-some-record foo) some-record? (foo some-record-foo)) (define-method (time-to-break (some-class ) not-a-class) (display "We're never going home are we?\n")) ;; Now it'll break (time-to-break (make ) (make-some-record 1))
bug#23404: Infinite recursion in GOOPS in Guile 2.2
Heya all,
So I've been building something with GOOPS, and I decided to try it out
with Guile 2.2. Unfortunately, I hit a pretty nasty bug. You can try
it yourself... the code is pretty short:
(use-modules (oop goops)
(srfi srfi-9))
(define-class ())
(define-method (time-to-break (some-class ) not-a-class)
(display "We're never going home are we?\n"))
;; And now, call it
(time-to-break (make ) 1)
This will loop forever and *never* complete. Why?
Turns out this is why, from goops.scm:
(define (single-arity-cache-dispatch cache nargs cache-miss)
(match cache
(() cache-miss)
(((typev . cmethod) . cache)
(cond
((eqv? nargs (vector-length typev))
(let ((cache-miss (single-arity-cache-dispatch cache nargs
cache-miss)))
I'm not sure what was supposed to happen (presumably the cache was
supposed to be narrowed down somehow), but what happens here is that
single-arity-cache-dispatch keeps calling single-arity-cache-dispatch
forever.
scheme@(guile-user) [1]> ,bt
In oop/goops.scm:
1437:41939 (cache-miss #< e8a1e0> #< id:
"5c787e65bbeb34b27ffd16eead286fc6:1" to: ("8394701db8…>)
1486:41938 (memoize-effective-method! _ _ _)
1466:131937 (recompute-generic-function-dispatch-procedure! #<
hive-process-message (1)>)
1452:161936 (compute-generic-function-dispatch-procedure _)
1378:251935 (single-arity-cache-dispatch _ 2 _)
1378:251934 (single-arity-cache-dispatch _ 2 _)
1378:251933 (single-arity-cache-dispatch _ 2 _)
1378:251932 (single-arity-cache-dispatch _ 2 _)
1378:251931 (single-arity-cache-dispatch _ 2 _)
1378:251930 (single-arity-cache-dispatch _ 2 _)
1378:251929 (single-arity-cache-dispatch _ 2 _)
1378:251928 (single-arity-cache-dispatch _ 2 _)
1378:251927 (single-arity-cache-dispatch _ 2 _)
1378:251926 (single-arity-cache-dispatch _ 2 _)
1378:251925 (single-arity-cache-dispatch _ 2 _)
1378:251924 (single-arity-cache-dispatch _ 2 _)
... etc ...
(g?)Oops!
- Chris
bug#21514: Guile 2.2: Sluggish elf calls, esp around arity / promises / statprof
Here's a fix to this bug. Tests pass, and performance appears to be
back here.
I've assigned copyright to the FSF for Guile so it should be fine to
commit!
>From 79e3b5286a2699f9b302bd3abf8a6b884b13a4f4 Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber
Date: Fri, 13 Nov 2015 20:42:31 -0600
Subject: [PATCH] Remove thunk / arity check in make-promise
* libguile/promises.c (s_scm_make_promise): Remove arity check in
make-promise. This was causing considerably slowdown with the new elf
code, causing considerable number of bytevector reading calls on
every call to (make-promise). Removing this check fixes a performance
regression in the new compiler.
---
libguile/promises.c | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/libguile/promises.c b/libguile/promises.c
index dcd0ac3..858b6f3 100644
--- a/libguile/promises.c
+++ b/libguile/promises.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2015
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -77,7 +77,6 @@ SCM_DEFINE (scm_make_promise, "make-promise", 1, 0, 0,
"@end lisp\n")
#define FUNC_NAME s_scm_make_promise
{
- SCM_VALIDATE_THUNK (1, thunk);
SCM_RETURN_NEWSMOB2 (scm_tc16_promise,
SCM_UNPACK (thunk),
SCM_UNPACK (scm_make_recursive_mutex ()));
--
2.1.4
bug#21514: Guile 2.2: Sluggish elf calls, esp around arity / promises / statprof
I was testing a program of mine under Guile 2.2, and was surprised to find things slower than in Guile 2.0, surprising given all the various optimizations I've heard about! However, I think I've found good clues as to what's going on. The tl;dr: there are a lot of calls to bytevector-u64-ref being called by the various elf utilities, and anything that checks debugging information, including anything checking arity (like promises!) gets slowed dramatically. First I ran statprof, and a number of procedure calls jumped to the top as most expensive, even though they hadn't in Guile 2.0. scheme@(activitystuff json-ld)> (statprof (lambda () (expand fjson-test-2)) #:loop 2000) % cumulative self time seconds seconds procedure 20.88 1.96 1.94 bytevector-u64-ref 15.79 3.72 1.47 system/vm/elf.scm:675:0:parse-elf64-section-header 8.25 1.19 0.77 system/vm/elf.scm:820:0:string-table-ref 5.44 6.25 0.51 system/vm/elf.scm:828:0:elf-section-by-name 5.09 0.47 0.47 system/vm/elf.scm:702:0:elf-section 3.86 0.36 0.36 utf8->string 3.33 0.38 0.31 /home/cwebber/devel/activitystuff/activitystuff/contrib/fash.scm:196:0:fash-ref 2.98 0.29 0.28 make-bytevector 2.63 0.24 0.24 bytevector-u32-ref 2.63 0.24 0.24 equal? 1.93 0.18 0.18 hash 1.40 0.13 0.13 bytevector-copy! Hm, that's a lot of calls to bytevector and elf things! Those weren't there before... where did they come from? I won't reproduce it here, but scheme@(activitystuff json-ld)> (statprof (lambda () (expand fjson-test-2)) #:loop 2000) led to an explosion of thousands of elf/bytevector references, not only at the top where some debugging checks might be expected, but much further on too. I noticed however that (make-promise) and checks to arity seem to be coming up a lot, so I decided to check that. In guile 2.0, here is what a simple (delay foo) looks like: scheme@(guile-user)> ,trace (delay (+ 1 2 3)) trace: | (# #(# #f #f # …)) trace: | #(# guile (guile) make-promise (…) #) trace: (#:1:0 ()>) trace: | (# …) trace: | | (nested-ref-module # (guile)) trace: | | | (module-ref-submodule # guile) trace: | | | | (# #) trace: | | | | # trace: | | | | (hashq-ref # guile) trace: | | | | # trace: | | | # trace: | | # trace: | | (# #) trace: | | | (# #<…>) trace: | | | # trace: | | # trace: | # trace: (make-promise #:1:0 ()>) trace: | (#) trace: | (() ((0 0 . 0)) ((2 5 0))) trace: #:1:0 ()>> In guile 2.2, it begins like this: scheme@(activitystuff json-ld)> ,trace (delay (+ 1 2 3)) trace: (# (guile) #:ensure #f) trace: | (nested-ref-module # (guile)) trace: | | (module-ref-submodule # guile) trace: | | | (# #) trace: | | | # trace: | | | (hashq-ref # guile) trace: | | | # trace: | | # trace: | # trace: | (# #) trace: | # trace: # trace: | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | -1> (make-promise #) trace: | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | -1> (program-minimum-arity #) trace: (program-code #:38:7 ()>) trace: 140173038389440 trace: | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | -1> (find-program-minimum-arity ?) trace: (find-debug-context 140173038389440) trace: | (find-mapped-elf-image 140173038389440) trace: | #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 0 0 0 0 176 2 0 0 0 0 0 0 0 0 0 0 ?) trace: (and=> #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 0 0 0 0 176 2 0 0 0 0 0 0 ?) #) trace: (debug-context-from-image #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 0 0 0 0 ?)) trace: | (parse-elf #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 0 0 0 0 176 2 0 0 0 ?)) trace: | | (has-elf-header? #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 0 0 0 0 176 ?)) trace: | | | (bytevector-length #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 0 0 0 ?)) trace: | | | 2523 trace: | | | (bytevector-length #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 0 0 0 ?)) trace: | | | 2523 trace: | | | (bytevector-u32-ref #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 0 0 ?) ?) trace: | | | 1 trace: | | #t trace: | (parse-elf64 #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 64 0 0 0 0 0 0 0 176 2 0 0 ?) ?) trace: | | (bytevector-u16-ref #vu8(127 69 76 70 2 1 1 255 0 0 0 0 0 0 0 0 3 0 0 0 1 0 0 0 0 0
