~alpine/aports

This thread contains a patchset. You're looking at the original emails, but you may wish to use the patch review UI. Review patch

[alpine-aports] [PATCH v3.3] main/guile: security upgrade - fixes #6366

Details
Message ID
<1481099085-646-1-git-send-email-sergej.lukin@gmail.com>
Sender timestamp
1481099085
DKIM signature
missing
Download raw message
Patch: +411 -1
CVE-2016-8605, CVE-2016-8606
---
 main/guile/APKBUILD                                |  10 +-
 ...016-8605-Thread-unsafe-umask-modification.patch |  82 ++++++
 ...vulnerable-to-HTTP-inter-protocol-attacks.patch | 320 +++++++++++++++++++++
 3 files changed, 411 insertions(+), 1 deletion(-)
 create mode 100644 main/guile/CVE-2016-8605-Thread-unsafe-umask-modification.patch
 create mode 100644 main/guile/CVE-2016-8606-REPL-server-vulnerable-to-HTTP-inter-protocol-attacks.patch

diff --git a/main/guile/APKBUILD b/main/guile/APKBUILD
index d401afd..ffbc028 100644
--- a/main/guile/APKBUILD
+++ b/main/guile/APKBUILD
@@ -1,7 +1,7 @@
# Maintainer: Natanael Copa <ncopa@alpinelinux.org>
pkgname=guile
pkgver=2.0.11
pkgrel=2
pkgrel=3
pkgdesc="Guile is a portable, embeddable Scheme implementation written in C"
url="http://www.gnu.org/software/guile/"
arch="all"
@@ -22,6 +22,8 @@ source="ftp://ftp.gnu.org/pub/gnu/$pkgname/$pkgname-$pkgver.tar.gz
	0013-Handle-p-in-format-warnings.patch
	0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch
	0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch
	CVE-2016-8605-Thread-unsafe-umask-modification.patch
	CVE-2016-8606-REPL-server-vulnerable-to-HTTP-inter-protocol-attacks.patch

	strtol_l.patch
	"
@@ -68,6 +70,8 @@ f140776c944bacc6cc14919f83902696  0003-Recognize-more-ARM-targets.patch
9e7b0d2d52e22b253ac314c6cb317bb4  0013-Handle-p-in-format-warnings.patch
9bb62ca4bd913b5ba6a94868a2d33464  0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch
04012be1e50736374564b14440e410f6  0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch
8e214ebdc5edaf0aa56d134eb7ce66c8  CVE-2016-8605-Thread-unsafe-umask-modification.patch
55248664c36c2cc4b1348f57a38eb23b  CVE-2016-8606-REPL-server-vulnerable-to-HTTP-inter-protocol-attacks.patch
54b76be46ecc9333e2a57cc0906c1927  strtol_l.patch"
sha256sums="e6786c934346fa2e38e46d8d81a622bb1c16d130153523f6129fcd79ef1fb040  guile-2.0.11.tar.gz
760355a63be9b756607a03352ceb916dfba02da917fa00c6bc07253d0f7c75f6  0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch
@@ -79,6 +83,8 @@ b7b3425c807d227dccf0ada653d3edd6d343d6c9d7ee648140bd13812f7776e7  0011-Fix-shrin
3557178fec43d58c62a505a3199054d4f32da97cfafaa969a8e9b90616bc603f  0013-Handle-p-in-format-warnings.patch
4ded8227e4b93a5205ddcf43f01e0e8c7684396669192b2e95b2c710573b6395  0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch
d28837b89c1653d9addf80573934dc97128a0c464b531f64fc58b1577f60340a  0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch
3f42410655221fb48cb5d9031d3a9ef28c4b6d3227ea0e67ea88d5d094e5236f  CVE-2016-8605-Thread-unsafe-umask-modification.patch
343c8b420cfab0d04babb34d58b367a91fc2036028055f75ef9569a3a8bb1880  CVE-2016-8606-REPL-server-vulnerable-to-HTTP-inter-protocol-attacks.patch
2ba49adb27db50f5ec33779ce2f002cafde99a04038ca689bee7d2098296ce33  strtol_l.patch"
sha512sums="dc1a30d44e6d432fab2407d72385e959af863f6feba6cca5813b4de24c92200c78b44f336d1f4fa8c7b4058dea880982787c69888c91a2236fd2fb1d313137fd  guile-2.0.11.tar.gz
b1c309cc07830ff1741ef88857f8099187b449580e8d57862886abc367ef1accc5a35636d81eee09247f13d3a751cdc8909fdea05368d3d509bd2039ce06d078  0002-Mark-mutex-with-owner-not-retained-threads-test-as-u.patch
@@ -90,4 +96,6 @@ b283ac11ca5d01a4ab102258ff896fb3fb6cb053144ea31ae0d43c0229c9b9509c4eadc90d757b23
8484e882723d68ea1e658a86c7be5006de1af7d457f7f9a37a99b427460db8420980174efdcaff8fbfa49346ba01252d2e6183c8b5e323bd228d223ed011655b  0013-Handle-p-in-format-warnings.patch
5f450e57968f2f0592a0de6beaa02db315d668a31a85330e3aa44d87995c82f866828fceb71012c123f5dd3b3b5c3ec944c8011ba09658ad00e8ce1c6f958a87  0015-Fix-SCM_SMOB_OBJECT-_-_0_-_1_-_2_-_3_-LOC.patch
f55e514534fd1aba547ed8d4350fbeeaef77d634d7f1915a0108244a9bef5afe7074f3292b9f74bdccd0c56cddc60e222e9ccd2519ba337b6f156123e632ec26  0016-peval-Handle-optional-argument-inits-that-refer-to-p.patch
95e022ee0bf0c622f8f3fe95218dea10720c1006b8f607906dbc890836390b81e807c9393447c5f9364325b8d63c0d557e889e23492150bfa6e6f72812e31619  CVE-2016-8605-Thread-unsafe-umask-modification.patch
27043f994c4654ac8df40398f7a9631ece1e63de00a31be6fdf49abd5092d26aaa4dd3e51339395405e3ac56459ee5942639c572441a50d7a2fdaab251c8d2db  CVE-2016-8606-REPL-server-vulnerable-to-HTTP-inter-protocol-attacks.patch
596efb03c65df98ea9afd932cb67e5b436e35fbf2442630e8a1854818f246b5a24eb920e3502ba28b882f0afb27c5148f1ff509c29baa91a7f37b3ecdc28c000  strtol_l.patch"
diff --git a/main/guile/CVE-2016-8605-Thread-unsafe-umask-modification.patch b/main/guile/CVE-2016-8605-Thread-unsafe-umask-modification.patch
new file mode 100644
index 0000000..905f6cf
--- /dev/null
+++ b/main/guile/CVE-2016-8605-Thread-unsafe-umask-modification.patch
@@ -0,0 +1,82 @@
CVE-2016-8605: Thread-unsafe umask modification

Remove 'umask' calls from 'mkdir'.
Fixes <http://bugs.gnu.org/24659>.

* libguile/filesys.c (SCM_DEFINE): Remove calls to 'umask' when MODE is
unbound; instead, use 0777 as the mode.  Update docstring to clarify
this.
* doc/ref/posix.texi (File System): Adjust accordingly.

This patch was slightly modified by Sergey Lukin <sergej.lukin@gmail.com>
Original patch is taken from:
http://git.savannah.gnu.org/cgit/guile.git/commit/?h=stable-2.0&id=245608911698adb3472803856019bdd5670b6614

Changes in 2.0.12 (since 2.0.11):


diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 2b9011d..a818604 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -864,9 +864,10 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
 @deffn {Scheme Procedure} mkdir path [mode]
 @deffnx {C Function} scm_mkdir (path, mode)
 Create a new directory named by @var{path}.  If @var{mode} is omitted
-then the permissions of the directory file are set using the current
-umask (@pxref{Processes}).  Otherwise they are set to the decimal
-value specified with @var{mode}.  The return value is unspecified.
+then the permissions of the directory are set to @code{#o777}
+masked with the current umask (@pxref{Processes, @code{umask}}).
+Otherwise they are set to the value specified with @var{mode}.
+The return value is unspecified.
 @end deffn
 
 @deffn {Scheme Procedure} rmdir path
diff --git a/libguile/filesys.c b/libguile/filesys.c
index e6e1db5..e6e37b0 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004, 2006,
- *   2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013, 2014, 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 License
@@ -1255,26 +1255,21 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
 SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
             (SCM path, SCM mode),
 	    "Create a new directory named by @var{path}.  If @var{mode} is omitted\n"
-	    "then the permissions of the directory file are set using the current\n"
-	    "umask.  Otherwise they are set to the decimal value specified with\n"
-	    "@var{mode}.  The return value is unspecified.")
+	    "then the permissions of the directory are set to @code{#o777}\n"
+	    "masked with the current umask (@pxref{Processes, @code{umask}}).\n"
+	    "Otherwise they are set to the value specified with @var{mode}.\n"
+	    "The return value is unspecified.")
 #define FUNC_NAME s_scm_mkdir
 {
   int rv;
-  mode_t mask;
+  mode_t c_mode;
 
-  if (SCM_UNBNDP (mode))
-    {
-      mask = umask (0);
-      umask (mask);
-      STRING_SYSCALL (path, c_path, rv = mkdir (c_path, 0777 ^ mask));
-    }
-  else
-    {
-      STRING_SYSCALL (path, c_path, rv = mkdir (c_path, scm_to_uint (mode)));
-    }
+  c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode);
+
+  STRING_SYSCALL (path, c_path, rv = mkdir (c_path, c_mode));
   if (rv != 0)
     SCM_SYSERROR;
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
diff --git a/main/guile/CVE-2016-8606-REPL-server-vulnerable-to-HTTP-inter-protocol-attacks.patch b/main/guile/CVE-2016-8606-REPL-server-vulnerable-to-HTTP-inter-protocol-attacks.patch
new file mode 100644
index 0000000..cada51c
--- /dev/null
+++ b/main/guile/CVE-2016-8606-REPL-server-vulnerable-to-HTTP-inter-protocol-attacks.patch
@@ -0,0 +1,320 @@
CVE-2016-8606: REPL server vulnerable to HTTP inter-protocol attacks

REPL Server: Guard against HTTP inter-protocol exploitation attacks.
Reported by Christopher Allan Webber <cwebber@dustycloud.org>
Co-authored-by: Ludovic Courtès <ludo@gnu.org>

This commit adds protection to Guile's REPL servers against HTTP
inter-protocol exploitation attacks, a scenario whereby an attacker can,
via an HTML page, cause a web browser to send data to TCP servers
listening on a loopback interface or private network.  See
<https://en.wikipedia.org/wiki/Inter-protocol_exploitation> and
<https://www.jochentopf.com/hfpa/hfpa.pdf>, The HTML Form Protocol
Attack (2001) by Tochen Topf <jochen@remote.org>.

Here we add a procedure to 'before-read-hook' that looks for a possible
HTTP request-line in the first line of input from the client socket.  If
present, the socket is drained and closed, and a loud warning is written
to stderr (POSIX file descriptor 2).

* module/system/repl/server.scm: Add 'maybe-check-for-http-request'
to 'before-read-hook' when this module is loaded.
(with-temporary-port-encoding, with-saved-port-line+column)
(drain-input-and-close, permissive-http-request-line?)
(check-for-http-request, guard-against-http-request)
(maybe-check-for-http-request): New procedures.
(serve-client): Use 'guard-against-http-request'.
* module/system/repl/coop-server.scm (start-repl-client): Use
'guard-against-http-request'.
* doc/ref/guile-invoke.texi (Command-line Options): In the description
of the --listen option, make the security warning more prominent.
Mention the new protection added here.  Recommend using UNIX domain
sockets for REPL servers.  "a path to" => "the file name of".

This patch was slightly modified by Sergey Lukin <sergej.lukin@gmail.com>
Original patch is taken from:
http://git.savannah.gnu.org/cgit/guile.git/commit/?h=stable-2.0&id=08c021916dbd3a235a9f9cc33df4c418c0724e03


diff --git a/doc/ref/guile-invoke.texi b/doc/ref/guile-invoke.texi
index 4cf833f..5be8f20 100644
--- a/doc/ref/guile-invoke.texi
+++ b/doc/ref/guile-invoke.texi
@@ -176,7 +176,7 @@ the @file{.guile} file.  @xref{Init File}.
 While this program runs, listen on a local port or a path for REPL
 clients.  If @var{p} starts with a number, it is assumed to be a local
 port on which to listen.  If it starts with a forward slash, it is
-assumed to be a path to a UNIX domain socket on which to listen.
+assumed to be the file name of a UNIX domain socket on which to listen.
 
 If @var{p} is not given, the default is local port 37146.  If you look
 at it upside down, it almost spells ``Guile''.  If you have netcat
@@ -184,12 +184,22 @@ installed, you should be able to @kbd{nc localhost 37146} and get a
 Guile prompt.  Alternately you can fire up Emacs and connect to the
 process; see @ref{Using Guile in Emacs} for more details.
 
-Note that opening a port allows anyone who can connect to that port---in
-the TCP case, any local user---to do anything Guile can do, as the user
+@quotation Note
+Opening a port allows anyone who can connect to that port to do anything
+Guile can do, as the user
 that the Guile process is running as.  Do not use @option{--listen} on
 multi-user machines.  Of course, if you do not pass @option{--listen} to
 Guile, no port will be opened.
 
+Guile protects against the
+@uref{https://en.wikipedia.org/wiki/Inter-protocol_exploitation,
+@dfn{HTTP inter-protocol exploitation attack}}, a scenario whereby an
+attacker can, @i{via} an HTML page, cause a web browser to send data to
+TCP servers listening on a loopback interface or private network.
+Nevertheless, you are advised to use UNIX domain sockets, as in
+@code{--listen=/some/local/file}, whenever possible.
+@end quotation
+
 That said, @option{--listen} is great for interactive debugging and
 development.
 
diff --git a/module/system/repl/coop-server.scm b/module/system/repl/coop-server.scm
index c19dda1..ae31ce8 100644
--- a/module/system/repl/coop-server.scm
+++ b/module/system/repl/coop-server.scm
@@ -1,6 +1,6 @@
 ;;; Cooperative REPL server
 
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014, 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
@@ -29,7 +29,8 @@
                 #:select (start-repl* prompting-meta-read))
   #:use-module ((system repl server)
                 #:select (run-server* make-tcp-server-socket
-                                      add-open-socket! close-socket!))
+                                      add-open-socket! close-socket!
+                                      guard-against-http-request))
   #:export (spawn-coop-repl-server
             poll-coop-repl-server))
 
@@ -173,6 +174,8 @@ and output is sent over the socket CLIENT."
   ;; another thread.
   (add-open-socket! client (lambda () (close-fdes (fileno client))))
 
+  (guard-against-http-request client)
+
   (with-continuation-barrier
    (lambda ()
      (coop-repl-prompt
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index ff9ee5c..9ece947 100644
--- a/module/system/repl/server.scm
+++ b/module/system/repl/server.scm
@@ -1,6 +1,6 @@
 ;;; Repl server
 
-;; Copyright (C)  2003, 2010, 2011, 2014 Free Software Foundation, Inc.
+;; Copyright (C)  2003, 2010, 2011, 2014, 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
@@ -22,8 +22,13 @@
 (define-module (system repl server)
   #:use-module (system repl repl)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 iconv)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)           ; cut
   #:export (make-tcp-server-socket
             make-unix-domain-server-socket
             run-server
@@ -154,6 +159,8 @@
     ;; Arrange to cancel this thread to forcefully shut down the socket.
     (add-open-socket! client (lambda () (cancel-thread thread))))
 
+  (guard-against-http-request client)
+
   (with-continuation-barrier
    (lambda ()
      (parameterize ((current-input-port client)
@@ -162,3 +169,176 @@
                     (current-warning-port client))
        (with-fluids ((*repl-stack* '()))
          (start-repl))))))
+
+
+;;;
+;;; The following code adds protection to Guile's REPL servers against
+;;; HTTP inter-protocol exploitation attacks, a scenario whereby an
+;;; attacker can, via an HTML page, cause a web browser to send data to
+;;; TCP servers listening on a loopback interface or private network.
+;;; See <https://en.wikipedia.org/wiki/Inter-protocol_exploitation> and
+;;; <https://www.jochentopf.com/hfpa/hfpa.pdf>, The HTML Form Protocol
+;;; Attack (2001) by Tochen Topf <jochen@remote.org>.
+;;;
+;;; Here we add a procedure to 'before-read-hook' that looks for a possible
+;;; HTTP request-line in the first line of input from the client socket.  If
+;;; present, the socket is drained and closed, and a loud warning is written
+;;; to stderr (POSIX file descriptor 2).
+;;;
+
+(define (with-temporary-port-encoding port encoding thunk)
+  "Call THUNK in a dynamic environment in which the encoding of PORT is
+temporarily set to ENCODING."
+  (let ((saved-encoding #f))
+    (dynamic-wind
+      (lambda ()
+        (unless (port-closed? port)
+          (set! saved-encoding (port-encoding port))
+          (set-port-encoding! port encoding)))
+      thunk
+      (lambda ()
+        (unless (port-closed? port)
+          (set! encoding (port-encoding port))
+          (set-port-encoding! port saved-encoding))))))
+
+(define (with-saved-port-line+column port thunk)
+  "Save the line and column of PORT before entering THUNK, and restore
+their previous values upon normal or non-local exit from THUNK."
+  (let ((saved-line #f) (saved-column #f))
+    (dynamic-wind
+      (lambda ()
+        (unless (port-closed? port)
+          (set! saved-line   (port-line   port))
+          (set! saved-column (port-column port))))
+      thunk
+      (lambda ()
+        (unless (port-closed? port)
+          (set-port-line!   port saved-line)
+          (set-port-column! port saved-column))))))
+
+(define (drain-input-and-close socket)
+  "Drain input from SOCKET using ISO-8859-1 encoding until it would block,
+and then close it.  Return the drained input as a string."
+  (dynamic-wind
+    (lambda ()
+      ;; Enable full buffering mode on the socket to allow
+      ;; 'get-bytevector-some' to return non-trivial chunks.
+      (setvbuf socket _IOFBF))
+    (lambda ()
+      (let loop ((chunks '()))
+        (let ((result (and (char-ready? socket)
+                           (get-bytevector-some socket))))
+          (if (bytevector? result)
+              (loop (cons (bytevector->string result "ISO-8859-1")
+                          chunks))
+              (string-concatenate-reverse chunks)))))
+    (lambda ()
+      ;; Close the socket even in case of an exception.
+      (close-port socket))))
+
+(define permissive-http-request-line?
+  ;; This predicate is deliberately permissive
+  ;; when checking the Request-URI component.
+  (let ((cs (ucs-range->char-set #x20 #x7E))
+        (rx (make-regexp
+             (string-append
+              "^(OPTIONS|GET|HEAD|POST|PUT|DELETE|TRACE|CONNECT) "
+              "[^ ]+ "
+              "HTTP/[0-9]+.[0-9]+$"))))
+    (lambda (line)
+      "Return true if LINE might plausibly be an HTTP request-line,
+otherwise return #f."
+      ;; We cannot simplify this to a simple 'regexp-exec', because
+      ;; 'regexp-exec' cannot cope with NUL bytes.
+      (and (string-every cs line)
+           (regexp-exec  rx line)))))
+
+(define (check-for-http-request socket)
+  "Check for a possible HTTP request in the initial input from SOCKET.
+If one is found, close the socket and print a report to STDERR (fdes 2).
+Otherwise, put back the bytes."
+  ;; Temporarily set the port encoding to ISO-8859-1 to allow lossless
+  ;; reading and unreading of the first line, regardless of what bytes
+  ;; are present.  Note that a valid HTTP request-line contains only
+  ;; ASCII characters.
+  (with-temporary-port-encoding socket "ISO-8859-1"
+    (lambda ()
+      ;; Save the port 'line' and 'column' counters and later restore
+      ;; them, since unreading what we read is not sufficient to do so.
+      (with-saved-port-line+column socket
+        (lambda ()
+          ;; Read up to (but not including) the first CR or LF.
+          ;; Although HTTP mandates CRLF line endings, we are permissive
+          ;; here to guard against the possibility that in some
+          ;; environments CRLF might be converted to LF before it
+          ;; reaches us.
+          (match (read-delimited "\r\n" socket 'peek)
+            ((? eof-object?)
+             ;; We found EOF before any input.  Nothing to do.
+             'done)
+
+            ((? permissive-http-request-line? request-line)
+             ;; The input from the socket began with a plausible HTTP
+             ;; request-line, which is unlikely to be legitimate and may
+             ;; indicate an possible break-in attempt.
+
+             ;; First, set the current port parameters to a void-port,
+             ;; to avoid sending any more data over the socket, to cause
+             ;; the REPL reader to see EOF, and to swallow any remaining
+             ;; output gracefully.
+             (let ((void-port (%make-void-port "rw")))
+               (current-input-port   void-port)
+               (current-output-port  void-port)
+               (current-error-port   void-port)
+               (current-warning-port void-port))
+
+             ;; Read from the socket until we would block,
+             ;; and then close it.
+             (let ((drained-input (drain-input-and-close socket)))
+
+               ;; Print a report to STDERR (POSIX file descriptor 2).
+               ;; XXX Can we do better here?
+               (call-with-port (dup->port 2 "w")
+                 (cut format <> "
+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+@@ POSSIBLE BREAK-IN ATTEMPT ON THE REPL SERVER                @@
+@@ BY AN HTTP INTER-PROTOCOL EXPLOITATION ATTACK.  See:        @@
+@@ <https://en.wikipedia.org/wiki/Inter-protocol_exploitation> @@
+@@ Possible HTTP request received: ~S
+@@ The associated socket has been closed.                      @@
+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
+                      (string-append request-line
+                                     drained-input)))))
+
+            (start-line
+             ;; The HTTP request-line was not found, so
+             ;; 'unread' the characters that we have read.
+             (unread-string start-line socket))))))))
+
+(define (guard-against-http-request socket)
+  "Arrange for the Guile REPL to check for an HTTP request in the
+initial input from SOCKET, in which case the socket will be closed.
+This guards against HTTP inter-protocol exploitation attacks, a scenario
+whereby an attacker can, via an HTML page, cause a web browser to send
+data to TCP servers listening on a loopback interface or private
+network."
+  (%set-port-property! socket 'guard-against-http-request? #t))
+
+(define* (maybe-check-for-http-request
+          #:optional (socket (current-input-port)))
+  "Apply check-for-http-request to SOCKET if previously requested by
+guard-against-http-request.  This procedure is intended to be added to
+before-read-hook."
+  (when (%port-property socket 'guard-against-http-request?)
+    (check-for-http-request socket)
+    (unless (port-closed? socket)
+      (%set-port-property! socket 'guard-against-http-request? #f))))
+
+;; Install the hook.
+(add-hook! before-read-hook
+           maybe-check-for-http-request)
+
+;;; Local Variables:
+;;; eval: (put 'with-temporary-port-encoding 'scheme-indent-function 2)
+;;; eval: (put 'with-saved-port-line+column  'scheme-indent-function 1)
+;;; End:

-- 
2.6.6



---
Unsubscribe:  alpine-aports+unsubscribe@lists.alpinelinux.org
Help:         alpine-aports+help@lists.alpinelinux.org
---
Reply to thread Export thread (mbox)