Hello community,

here is the log from the commit of package guile.5728 for openSUSE:13.2:Update 
checked in at 2016-10-26 11:07:56
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:13.2:Update/guile.5728 (Old)
 and      /work/SRC/openSUSE:13.2:Update/.guile.5728.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Package is "guile.5728"

Changes:
--------
New Changes file:

--- /dev/null   2016-09-15 12:42:18.240042505 +0200
+++ /work/SRC/openSUSE:13.2:Update/.guile.5728.new/guile.changes        
2016-10-26 11:07:57.000000000 +0200
@@ -0,0 +1,875 @@
+-------------------------------------------------------------------
+Mon Oct 17 12:30:38 UTC 2016 - [email protected]
+
+- security update
+  * CVE-2016-8605 [bsc#1004221]
+    + guile-CVE-2016-8605.patch
+  * CVE-2016-8606 [bsc#1004226]
+    + guile-CVE-2016-8606.patch
+
+-------------------------------------------------------------------
+Tue Apr 22 12:17:08 UTC 2014 - [email protected]
+
+- install libguile*-gdb.scm into
+  %{_datadir}/gdb/auto-load%{_libdir}/  [bnc#874028]
+
+-------------------------------------------------------------------
+Mon Mar 31 11:33:15 UTC 2014 - [email protected]
+
+- updated to 2.0.11:
+   ** New GDB extension to support Guile
+   ** Improved integration between R6RS and native Guile exceptions
+   ** Support for HTTP proxies
+   ** Lexical syntax improvements
+   *** Support |...| symbol notation
+   *** Support '#true' and '#false' notation for booleans.
+   *** Recognize '#\escape' character name.
+   *** Accept "\|" in string literals.
+   ** Custom binary input ports now support 'setvbuf'.
+   ** SRFI-4 predicates and length accessors no longer accept arrays.
+   ** GUILE_PROGS now supports specifying a minimum required version.
+   etc, see NEWS. 
+
+-------------------------------------------------------------------
+Mon Apr 15 06:51:08 UTC 2013 - [email protected]
+
+- updated to 2.0.9:
+  ** New keyword arguments for procedures that open files
+  ** Numerics improvements
+  ** New optimizations
+  ** `peek-char' no longer consumes EOF
+  ** SLIB compatibility restored
+  ** Better ,trace REPL command
+  ** Better docstring syntax supported for `case-lambda'
+  ** Improved handling of Unicode byte order marks
+  etc. see NEWS for more/details
+- removed unneeded gc-test.patch
+
+-------------------------------------------------------------------
+Tue Feb  5 18:36:49 UTC 2013 - [email protected]
+
+- move .so file to libguilereadline package [bnc#765436]
+
+-------------------------------------------------------------------
+Mon Dec 17 08:15:45 UTC 2012 - [email protected]
+
+- fixed build: net-db.test takes EAI_SYSTEM error by
+  * net-db-test.patch [bnc#794696]
+- turn off one test in gc.test
+  * gc-test.patch
+    http://lists.gnu.org/archive/html/bug-guile/2012-07/msg00069.html
+
+-------------------------------------------------------------------
+Mon Dec  3 09:20:21 UTC 2012 - [email protected]
+
+- update to 2.0.7:
+  * Notable changes
+  ** SRFI-105 curly infix expressions are supported
+  ** Reader options may now be per-port
+  ** Futures may now be nested
+  ** `GUILE_LOAD_PATH' et al can now add directories to the end of 
+     the path
+  ** `load-in-vicinity' search for `.go' files in `%load-compiled-path'
+  ** Extension search order fixed, and LD_LIBRARY_PATH preserved
+  ** Optimize calls to `equal?' or `eqv?' with a constant argument
+  * Manual updates
+  ** SRFI-9 records now documented under "Compound Data Types"
+  ** (ice-9 and-let-star) and (ice-9 curried-definitions) now documented
+  * New interfaces
+  ** New "functional record setters" as a GNU extension of SRFI-9
+  ** web: New `http-get*', `response-body-port', and `text-content-type?'
+     procedures
+  ** `string-split' accepts character sets and predicates
+  ** R6RS SRFI support
+  ** `define-public' is no a longer curried definition by default
+
+  etc. see NEWS
+  
+-------------------------------------------------------------------
+Wed Jul 11 07:39:47 UTC 2012 - [email protected]
+
+- update to 2.0.6:
+
+  * Notable changes
+  ** New optimization pass: common subexpression elimination (CSE)
+  ** Improvements to the partial evaluator
+  ** Run finalizers asynchronously in asyncs
+  ** Update SRFI-14 character sets to Unicode 6.1
+  ** Better source information for datums
+  ** Improved error and warning messages
+  ** A few important bug fixes in the HTTP modules.
+  ** Pretty-print improvements
+  ** Fix memory leak involving applicable SMOBs
+  ** Support for HTTP/1.1 chunked transfer coding
+  ** Micro-optimizations
+  ** Incompatible change to `scandir'
+
+  * New interfaces
+  ** New C function: `scm_to_pointer'
+  ** New C inline functions: `scm_new_smob', `scm_new_double_smob'
+  ** (ice-9 format): Add ~h specifier for localized number output.
+  ** (web response): New procedure: `response-must-not-include-body?'
+  ** New predicate: 'supports-source-properties?'
+  ** New C helpers: `scm_c_values', `scm_c_nvalues'
+  ** Newly public inline C function: `scm_unget_byte'
+  ** (language tree-il): New functions: `tree-il=?', `tree-il-hash'
+  ** New fluid: `%default-port-conversion-strategy'
+  ** New syntax: `=>' within `case'
+  ** (web http): `make-chunked-input-port', `make-chunked-output-port'
+  ** (web http): `declare-opaque-header!'
+
+  * New deprecations
+  ** `close-io-port' deprecated
+  ** `scm_sym2var' deprecated
+  ** Lookup closures deprecated
+
+  * Bug fixes
+  ** Fix use of unitialized stat buffer in search-path of absolute paths.
+  ** Avoid calling `freelocale' with a NULL argument.
+  ** Work around erroneous tr_TR locale in Darwin 8 in tests.
+  ** Fix `getaddrinfo' test for Darwin 8.
+  ** Use Gnulib's `regex' module for better regex portability.
+  ** `source-properties' and friends work on any object
+  ** Rewrite open-process in C, for robustness related to threads and fork
+  ** Fix <TAG>vector-length when applied to other uniform vector types
+  ** Fix escape-only prompt optimization (was disabled previously)
+  ** Fix a segfault when /dev/urandom is not accessible
+  ** Fix flush on soft ports, so that it actually runs.
+  ** Better compatibility of SRFI-9 records with core records
+  ** Fix and clarify documentation of `sorted?'.
+  ** Fix IEEE-754 endianness conversion in bytevectors.
+  ** Correct thunk check in the `wind' instruction.
+  ** Add @acronym support to texinfo modules
+  ** Fix docbook->texi for <ulink> without URL
+  ** Fix `setvbuf' to leave the line/column number unchanged.
+  ** Add missing public declaration for `scm_take_from_input_buffers'.
+  ** Fix relative file name canonicalization with empty %LOAD-PATH entries.
+  ** Import newer (ice-9 match) from Chibi-Scheme.
+  ** Fix unbound variables and unbound values in ECMAScript runtime.
+  ** Make SRFI-6 string ports Unicode-capable.
+- removed patches:
+   guile-turn-off-gc-test.patch
+   guile-fix_fsf_add.patch
+
+-------------------------------------------------------------------
+Fri Jun 29 09:26:41 UTC 2012 - [email protected]
+
+- libffi-devel is more generic than specific gcc versions (that no longer
+  exist in factory)
+
+-------------------------------------------------------------------
+Mon Apr 23 17:16:38 UTC 2012 - [email protected]
+
+- mark this threads test as unresolved since it may produce false 
+  negatives, depending on the behavior/timing of the garbage 
+  collector. 
+
+-------------------------------------------------------------------
+Tue Jan 31 15:10:31 UTC 2012 - [email protected]
+
+- update to 2.0.5:
+  ** Better debuggability for interpreted procedures.
+  ** Support for cross-compilation.
+  ** The return of `local-eval'.
+  ** Fluids can now have default values.
+  ** Garbage collector tuning.
+  *** Unmanaged allocation
+  * etc. see NEWS
+
+-------------------------------------------------------------------
+Wed Jan 18 16:21:57 UTC 2012 - [email protected]
+
+- don't conflict with guile1 [bnc#724917]
+
+-------------------------------------------------------------------
+Fri Dec  9 10:38:37 UTC 2011 - [email protected]
+
+- Drop libtool archives.
+
+-------------------------------------------------------------------
+Sat Dec  3 14:24:16 UTC 2011 - [email protected]
+
+- buildrequire ltdl-devel
+
+-------------------------------------------------------------------
+Mon Nov 28 15:51:34 UTC 2011 - [email protected]
+
+- splitted out guile-modules-2_0 package [bnc#722306]
++++ 678 more lines (skipped)
++++ between /dev/null
++++ and /work/SRC/openSUSE:13.2:Update/.guile.5728.new/guile.changes

New:
----
  guile-1.6.10-mktemp.patch
  guile-2.0.11.tar.gz
  guile-64bit.patch
  guile-CVE-2016-8605.patch
  guile-CVE-2016-8606.patch
  guile-net-db-test.patch
  guile-rpmlintrc
  guile-threads-test.patch
  guile.changes
  guile.spec

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Other differences:
------------------
++++++ guile.spec ++++++
#
# spec file for package guile
#
# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
# upon. The license for this file, and modifications and additions to the
# file, is the same license as for the pristine package itself (unless the
# license for the pristine package is not an Open Source License, in which
# case the license is the MIT License). An "Open Source License" is a
# license that conforms to the Open Source Definition (Version 1.9)
# published by the Open Source Initiative.

# Please submit bugfixes or comments via http://bugs.opensuse.org/
#


# define the name used for versioning libs and directories.
%define guilemaj    2
%define guilemin    0
%define guilevers   %{guilemaj}.%{guilemin}
%define libgver     22
%define gsuff       %{guilemaj}_%{guilemin}-%{libgver}
%define libgreadver 18
%define greadsuff   v-%{libgreadver}-%{libgreadver}

Name:           guile
BuildRequires:  gc-devel
BuildRequires:  gmp-devel
BuildRequires:  libffi-devel
BuildRequires:  libltdl-devel
BuildRequires:  libunistring-devel
BuildRequires:  pkg-config
BuildRequires:  readline-devel
Version:        %{guilevers}.11
Release:        0
Summary:        GNU's Ubiquitous Intelligent Language for Extension
License:        GFDL-1.3 and GPL-3.0+ and LGPL-3.0+
Group:          Development/Languages/Scheme
Url:            http://www.gnu.org/software/guile/
Source0:        ftp://ftp.gnu.org/gnu/guile/%{name}-%{version}.tar.gz
Source1:        guile-rpmlintrc
Patch1:         %{name}-64bit.patch
Patch2:         %{name}-1.6.10-mktemp.patch
Patch3:         %{name}-threads-test.patch
Patch4:         %{name}-net-db-test.patch
Patch5:         guile-CVE-2016-8605.patch
Patch6:         guile-CVE-2016-8606.patch
BuildRoot:      %{_tmppath}/%{name}-%{version}-build
PreReq:         fileutils sh-utils
PreReq:         %install_info_prereq
Conflicts:      slib < 3a5

%description
This is Guile, a portable, embeddable Scheme implementation written in
C. Guile provides a machine independent execution platform that can be
linked in as a library when building extensible programs.

%package -n libguile-%{gsuff}
Summary:        GNU's Ubiquitous Intelligent Language for Extension
License:        GFDL-1.3 and GPL-3.0+ and LGPL-3.0+
Group:          Development/Languages/Scheme
Requires:       %{name}-modules-%{guilemaj}_%{guilemin} >= %{version}

%description -n libguile-%{gsuff}
This is Guile, a portable, embeddable Scheme implementation written in
C. Guile provides a machine independent execution platform that can be
linked in as a library when building extensible programs. This package
contains the shared libraries.

%package modules-%{guilemaj}_%{guilemin}
Summary:        GNU's Ubiquitous Intelligent Language for Extension
License:        GFDL-1.3 and GPL-3.0+ and LGPL-3.0+
Group:          Development/Languages/Scheme

%description modules-%{guilemaj}_%{guilemin}
This is Guile, a portable, embeddable Scheme implementation written in
C. Guile provides a machine independent execution platform that can be
linked in as a library when building extensible programs. This package
contains guile modules.

%package -n libguilereadline-%{greadsuff}
Summary:        GNU's Ubiquitous Intelligent Language for Extension
License:        GFDL-1.3 and GPL-3.0+ and LGPL-3.0+
Group:          Development/Languages/Scheme

%description -n libguilereadline-%{greadsuff}
This is Guile, a portable, embeddable Scheme implementation written in
C. Guile provides a machine independent execution platform that can be
linked in as a library when building extensible programs. This package
contains the shared libraries.

%package devel
Summary:        GNU's Ubiquitous Intelligent Language for Extension
License:        LGPL-2.1+
Group:          Development/Languages/Scheme
Requires:       gc-devel
Requires:       gmp-devel
Requires:       libffi-devel
Requires:       libunistring-devel
Requires:       ncurses-devel
Requires:       readline-devel
# following Requires needed because /usr/bin/guile-config needs /usr/bin/guile
Requires:       guile = %{version}
Requires:       libguile-%{gsuff} = %{version}
Requires:       libguilereadline-%{greadsuff} = %{version}

%description devel
This is Guile, a portable, embeddable Scheme implementation written in
C. Guile provides a machine independent execution platform that can be
linked in as a library when building extensible programs.

%prep
%setup -q
%patch1
%patch2
%patch3 -p1
%patch4 -p1
%patch5 -p1
%patch6 -p1
# force rebuild with non-broken makeinfo
#rm -f doc/*/*.info

%build
# FIXME: Following files are apparently compiled without RPM_OPT_FLAGS:
# gen-scmconfig.c,c-tokenize.c

%configure --disable-static --with-pic \
        --with-threads --disable-silent-rules
make

%check
LD_LIBRARY_PATH="." make check

%install
make install DESTDIR=$RPM_BUILD_ROOT
mkdir -p $RPM_BUILD_ROOT%{_datadir}/guile/site
find %{buildroot}%{_libdir} -type f -name '*.la' -delete -print
# bug #874028
mkdir -p %{buildroot}%{_datadir}/gdb/auto-load%{_libdir}
mv %{buildroot}%{_libdir}/libguile*-gdb.scm 
%{buildroot}%{_datadir}/gdb/auto-load%{_libdir}/

%post devel
%install_info --info-dir=%{_infodir} %{_infodir}/%{name}.info.gz
%install_info --info-dir=%{_infodir} %{_infodir}/r5rs.info.gz

%postun devel
%install_info_delete --info-dir=%{_infodir} %{_infodir}/%{name}.info.gz
%install_info_delete --info-dir=%{_infodir} %{_infodir}/r5rs.info.gz

%pre
# Remove obsolete files (< SuSE Linux 10.2)
rm -f var/adm/SuSEconfig/md5/usr/share/guile/*/slibcat
rm -f usr/share/guile/site/slibcat.SuSEconfig

%post -n libguile-%{gsuff} -p /sbin/ldconfig

%postun -n libguile-%{gsuff} -p /sbin/ldconfig

%post -n libguilereadline-%{greadsuff} -p /sbin/ldconfig

%postun -n libguilereadline-%{greadsuff} -p /sbin/ldconfig

%files
%defattr(-,root,root)
%doc ABOUT-NLS AUTHORS COPYING* ChangeLog GUILE-VERSION HACKING
%doc LICENSE NEWS README THANKS
%{_bindir}/guile-tools
%{_bindir}/guild
%{_bindir}/guile
%{_mandir}/man1/guile.1.gz

%files -n libguile-%{gsuff}
%defattr(-,root,root)
%{_libdir}/libguile-%{guilevers}.so.%{libgver}*

%files modules-%{guilemaj}_%{guilemin}
%defattr(-,root,root)
%{_libdir}/%{name}
# Own usr/share/guile/site; side effect of not doing so is slib failing to 
install correctly.
%{_datadir}/%{name}

%files  -n libguilereadline-%{greadsuff}
%defattr(-,root,root)
# please leave .so file here [bnc#765436]
%{_libdir}/libguilereadline-v-%{libgreadver}.so
%{_libdir}/libguilereadline-v-%{libgreadver}.so.%{libgreadver}*

%files devel
%defattr(-,root,root)
%{_bindir}/guile-snarf
%{_bindir}/guile-config
%dir %{_includedir}/%{name}
%dir %{_includedir}/%{name}/%{guilevers}
%{_includedir}/%{name}/%{guilevers}/*
%{_datadir}/aclocal/guile.m4
%doc %{_infodir}/%{name}.info.gz
%doc %{_infodir}/%{name}.info-[0-9].gz
%doc %{_infodir}/%{name}.info-1[0-9].gz
%doc %{_infodir}/r5rs.info.gz
%{_libdir}/libguile-%{guilevers}.so
%{_libdir}/pkgconfig/guile-%{guilevers}.pc
# bug #874028
%dir %{_datadir}/gdb
%dir %{_datadir}/gdb/auto-load
%dir %{_datadir}/gdb/auto-load%{_prefix}
%dir %{_datadir}/gdb/auto-load/%{_libdir}
%{_datadir}/gdb/auto-load/%{_libdir}/libguile*-gdb.scm

%changelog
++++++ guile-1.6.10-mktemp.patch ++++++
Index: libguile/guile-snarf.in
===================================================================
--- libguile/guile-snarf.in.orig        2011-05-05 18:14:35.000000000 +0200
+++ libguile/guile-snarf.in     2011-09-22 17:56:41.010417735 +0200
@@ -84,8 +84,7 @@ fi
 cpp_ok_p=false
 
 if [ x"$TMPDIR" = x ]; then TMPDIR="/tmp" ; else : ; fi
-tempdir="$TMPDIR/guile-snarf.$$"
-(umask 077 && mkdir $tempdir) || exit 1
+tempdir=$(mktemp -d -q "$TMPDIR/snarf.XXXXXX") || { echo >&2 "guile-snarf: can 
not create temporary file"; exit 1; }
 temp="$tempdir/tmp"
 
 if [ x"$CPP" = x ] ; then cpp="@CPP@" ; else cpp="$CPP" ; fi
++++++ guile-64bit.patch ++++++
Index: libguile/hash.c
===================================================================
--- libguile/hash.c.orig
+++ libguile/hash.c
@@ -273,7 +273,7 @@ scm_hasher(SCM obj, unsigned long n, siz
 unsigned long
 scm_ihashq (SCM obj, unsigned long n)
 {
-  return (SCM_UNPACK (obj) >> 1) % n;
+  return ((unsigned long) SCM_UNPACK (obj) >> 1) % n;
 }
 
 
@@ -309,7 +309,7 @@ scm_ihashv (SCM obj, unsigned long n)
   if (SCM_NUMP(obj))
     return (unsigned long) scm_hasher(obj, n, 10);
   else
-    return SCM_UNPACK (obj) % n;
+    return (unsigned long) SCM_UNPACK (obj) % n;
 }
 
 
Index: libguile/struct.c
===================================================================
--- libguile/struct.c.orig
+++ libguile/struct.c
@@ -919,7 +919,7 @@ scm_struct_ihashq (SCM obj, unsigned lon
 {
   /* The length of the hash table should be a relative prime it's not
      necessary to shift down the address.  */
-  return SCM_UNPACK (obj) % n;
+  return (unsigned long) SCM_UNPACK (obj) % n;
 }
 
 /* Return the hash of struct OBJ, modulo N.  Traverse OBJ's fields to
++++++ guile-CVE-2016-8605.patch ++++++
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -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
++++++ guile-CVE-2016-8606.patch ++++++
--- a/module/system/repl/coop-server.scm
+++ b/module/system/repl/coop-server.scm
@@ -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 <[email protected]>.
+;;;
+;;; 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:
++++++ guile-net-db-test.patch ++++++
Index: guile-2.0.7/test-suite/tests/net-db.test
===================================================================
--- guile-2.0.7.orig/test-suite/tests/net-db.test
+++ guile-2.0.7/test-suite/tests/net-db.test
@@ -79,6 +79,7 @@
                      (and (defined? 'EAI_NODATA)  ; GNU extension
                           (= errcode EAI_NODATA))
                      (= errcode EAI_AGAIN)
+                     (= errcode EAI_SYSTEM)
                      (begin
                        (format #t "unexpected error code: ~a ~s~%"
                                errcode (gai-strerror errcode))
@@ -105,6 +106,7 @@
             ;; `EAI_NONAME'.)
             (and (or (= errcode EAI_SERVICE)
                      (= errcode EAI_NONAME)
+                     (= errcode EAI_SYSTEM)
                      (and (defined? 'EAI_NODATA)
                           (= errcode EAI_NODATA)))
                  (string? (gai-strerror errcode))))))))
++++++ guile-rpmlintrc ++++++
addFilter("libguilereadline.* devel-file-in-non-devel-package")++++++ 
guile-threads-test.patch ++++++
Index: guile-2.0.5/test-suite/tests/threads.test
===================================================================
--- guile-2.0.5.orig/test-suite/tests/threads.test
+++ guile-2.0.5/test-suite/tests/threads.test
@@ -414,8 +414,10 @@
 
             (gc) (gc)
             (let ((m (g)))
-              (and (mutex? m)
-                   (eq? (mutex-owner m) (current-thread)))))))
+              (or
+               (and (mutex? m)
+                    (eq? (mutex-owner m) (current-thread)))
+               (throw 'unresolved))))))
 
       ;;
       ;; mutex lock levels

Reply via email to