File CVE-2013-1841.patch of Package perl-Net-Server

From dd7c587d44b40a225ad90f7559ebf00967f4e5fc Mon Sep 17 00:00:00 2001
From: Paul Seamons <paul.seamons@newfold.com>
Date: Wed, 30 Nov 2022 22:37:35 -0700
Subject: [PATCH] Add double_reverse_lookups capability

---
 lib/Net/Server.pm  | 57 ++++++++++++++++++++++++++++++++------
 lib/Net/Server.pod | 68 +++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 115 insertions(+), 10 deletions(-)

diff --git a/lib/Net/Server.pm b/lib/Net/Server.pm
index d899cd5..613dcac 100644
--- a/lib/Net/Server.pm
+++ b/lib/Net/Server.pm
@@ -180,6 +180,10 @@ sub post_configure {
 
     # make sure that allow and deny look like array refs
     $prop->{$_} = [] for grep {! ref $prop->{$_}} qw(allow deny cidr_allow cidr_deny);
+
+    $prop->{'reverse_lookups'} ||= 1 if $prop->{'double_reverse_lookups'};
+    $prop->{'double_reverse_lookups'} = $1 || $prop->{'double_reverse_lookups'} || 1
+        if $prop->{'reverse_lookups'} && $prop->{'reverse_lookups'} =~ /^(?:double|2)(.*)$/i;
 }
 
 sub initialize_logging {
@@ -541,18 +545,25 @@ sub get_client_info {
         @{ $prop }{qw(peeraddr peerhost peerport)} = ('0.0.0.0', 'inet.test', 0); # commandline
     }
 
-    if ($addr && defined $prop->{'reverse_lookups'}) {
+    if ($addr && $prop->{'reverse_lookups'}) {
         if ($INC{'Socket6.pm'} && Socket6->can('getnameinfo')) {
             my @res = Socket6::getnameinfo($addr, 0);
-            $prop->{'peerhost'} = $res[0] if @res > 1;
-        }else{
+            if (@res > 1) {
+                $prop->{'peerhost'} = $res[0];
+            } elsif ($prop->{'peeraddr'} =~ /^(?:::ffff:)?(\d+(?:\.\d+){3})$/) {
+                $prop->{'peerhost'} = gethostbyaddr(Socket::inet_aton($1), AF_INET);
+            }
+        } else {
             $prop->{'peerhost'} = gethostbyaddr($addr, AF_INET);
         }
+        if ($prop->{'peerhost'} && $prop->{'double_reverse_lookups'}) {
+            $prop->{'peerhost_rev'} = {map {$_->[0] => 1} Net::Server::Proto->get_addr_info($prop->{'peerhost'})};
+        }
     }
 
     $self->log(3, $self->log_time
                ." CONNECT ".$client->NS_proto
-               ." Peer: \"[$prop->{'peeraddr'}]:$prop->{'peerport'}\""
+               ." Peer: \"[$prop->{'peeraddr'}]:$prop->{'peerport'}\"".($prop->{'peerhost'} ? " ($prop->{'peerhost'}) " : '')
                ." Local: \"[$prop->{'sockaddr'}]:$prop->{'sockport'}\"") if $prop->{'log_level'} && 3 <= $prop->{'log_level'};
 }
 
@@ -566,16 +577,20 @@ sub allow_deny {
     # unix sockets are immune to this check
     return 1 if $sock && $sock->NS_proto =~ /^UNIX/;
 
+    # work around Net::CIDR::cidrlookup() croaking,
+    # if first parameter is an IPv4 address in IPv6 notation.
+    my $peeraddr = ($prop->{'peeraddr'} =~ /^\s*::ffff:([0-9.]+\s*)$/) ? $1 : $prop->{'peeraddr'};
+
+    if ($prop->{'double_reverse_lookups'}) {
+        return 0 if ! $self->double_reverse_lookup($peeraddr, $prop->{'peerhost'}, $prop->{'peerhost_rev'}, $prop->{'peeraddr'})
+    }
+
     # if no allow or deny parameters are set, allow all
     return 1 if ! @{ $prop->{'allow'} }
              && ! @{ $prop->{'deny'} }
              && ! @{ $prop->{'cidr_allow'} }
              && ! @{ $prop->{'cidr_deny'} };
 
-    # work around Net::CIDR::cidrlookup() croaking,
-    # if first parameter is an IPv4 address in IPv6 notation.
-    my $peeraddr = ($prop->{'peeraddr'} =~ /^\s*::ffff:([0-9.]+\s*)$/) ? $1 : $prop->{'peeraddr'};
-
     # if the addr or host matches a deny, reject it immediately
     foreach (@{ $prop->{'deny'} }) {
         return 0 if $prop->{'reverse_lookups'}
@@ -601,6 +616,30 @@ sub allow_deny {
     return 0;
 }
 
+sub double_reverse_lookup {
+    my ($self, $addr, $host, $rev_addrs, $orig_addr) = @_;
+    my $cfg = $self->{'server'}->{'double_reverse_lookups'} || '';
+    if (! $host) {
+        $self->log(3, $self->log_time ." Double reverse missing host from addr $addr");
+        return 0;
+    } elsif (! $rev_addrs) {
+        $self->log(3, $self->log_time ." Double reverse missing reverse addrs from host $host ($addr)");
+        return 0;
+    }
+    my $extra = ($orig_addr && $orig_addr ne $addr) ? ",  orig_addr: $orig_addr" : '';
+    if (! $rev_addrs->{$addr} && ! $rev_addrs->{$orig_addr}) {
+        $self->log(3, $self->log_time ." Double reverse did not match:  addr: $addr,  host: $host"
+            .($cfg =~ /detail/i ? ",  addrs: (".join(' ', sort keys %$rev_addrs).")$extra" : ''));
+        return 0;
+    } elsif ($cfg =~ /autofail/i) {
+        $self->log(3, $self->log_time ." Double reverse autofail:  addr: $addr,  host: $host,  addrs: (".join(' ', sort keys %$rev_addrs).")$extra");
+        return 0;
+    } elsif ($cfg =~ /debug/) {
+        $self->log(3, $self->log_time ." Double reverse debug:  addr: $addr,  host: $host,  addrs: (".join(' ', sort keys %$rev_addrs).")$extra");
+    }
+    return 1;
+}
+
 sub allow_deny_hook { 1 } # false to deny request
 
 sub request_denied_hook {}
@@ -960,7 +999,7 @@ sub options {
     foreach (qw(conf_file
                 user group chroot log_level
                 log_file pid_file background setsid
-                listen reverse_lookups
+                listen ipv6_package reverse_lookups double_reverse_lookups
                 no_close_by_child
                 no_client_stdout tie_client_stdout tied_stdout_callback tied_stdin_callback
                 leave_children_open_on_hup
diff --git a/lib/Net/Server.pod b/lib/Net/Server.pod
index 781982a..41cb2c0 100644
--- a/lib/Net/Server.pod
+++ b/lib/Net/Server.pod
@@ -439,6 +439,8 @@ base class.)
     ipv               (4|6|*)                  *
     proto             (tcp|udp|unix)           "tcp"
     listen            \d+                      SOMAXCONN
+    ipv6_package      (IO::Socket::INET6       IO::Socket::IP
+                       |IO::Socket::IP)
 
     ## syslog parameters (if log_file eq Sys::Syslog)
     syslog_logsock    (native|unix|inet|udp
@@ -447,7 +449,8 @@ base class.)
     syslog_logopt     (cons|ndelay|nowait|pid) pid
     syslog_facility   \w+                      daemon
 
-    reverse_lookups   1                        undef
+    reverse_lookups   (1|double|double-debug)  undef
+    double_reverse_lookups  (1|debug|autofail) undef
     allow             /regex/                  none
     deny              /regex/                  none
     cidr_allow        CIDR                     none
@@ -819,12 +822,65 @@ Socket6::AF_INET6 or Socket::AF_UNSPEC, and it is short.
 
 See L<IO::Socket>.  Not used with udp protocol (or UNIX SOCK_DGRAM).
 
+=item ipv6_package
+
+Net::Server::Proto will try to determine the appropriate socket
+class to use if a v6 socket is needed.  It will default to
+trying IO::Socket::IP first, and then IO::Socket::INET6.  Specifying
+this package allows for a specific package to be used (note that
+IO::Socket::SSL used by Proto::SSL does its own ipv6 socket package
+determination).
+
 =item reverse_lookups
 
 Specify whether to lookup the hostname of the connected IP.
 Information is cached in server object under C<peerhost> property.
 Default is to not use reverse_lookups (undef).
 
+Can be set to the values "double", "double-detail", "double-autofail",
+or "double-debug" to set double_reverse_lookups.
+
+=item double_reverse_lookups
+
+If set, also sets reverse_lookups.
+
+Same as setting reverse_lookups to "double".  Looks up the IPs
+that the hostname resolves to to make sure the connection ip is one
+of those ips.
+
+Sets peerhost_rev as a hashref of ip addresses the name resolved to
+during get_client_info.
+
+If double_reverse_lookups is set, the double_reverse_lookup method
+is called during the allow_deny method.  The
+double_reverse_lookup method is passed:
+
+    addr  - the IPv4 or IPv6 address
+    host  - the hostname the addr resolved to
+    addrs - the hashref of ip addresses the host resolved to
+    orig  - the original unfiltered addr
+
+Makes allow_deny return false if there is no hostname, no reverse ips,
+or if one of the ip addrs does not match the connection ip addr.
+Sends a log level 3 message.
+
+Can set double_reverse_lookups to one of the following to adjust logging:
+
+    detail   - add addrs to the failure messages
+    autofail - fail on every connection and log
+    debug    - log address information (but not fail) for successful connections
+
+The following one liners can help with debugging:
+
+    net-server HTTP --reverse_lookups=double-debug --log_level=3
+    # curl localhost:8080 in other window
+
+    2022/11/30-22:16:45 CONNECT TCP Peer: "[::ffff:127.0.0.1]:44766" (localhost)  Local: "[::ffff:127.0.0.1]:8080"
+    2022/11/30-22:16:45 Double reverse debug:  addr: 127.0.0.1,  host: localhost,  addrs: (127.0.0.1),  orig_addr: ::ffff:127.0.0.1
+
+The double_reverse_lookup is called before running any allow/deny
+rules.
+
 =item allow/deny
 
 May be specified multiple times.  Contains regex to compare to
@@ -1096,6 +1152,9 @@ represents the program flow:
 
     $self->post_client_connection_hook;
 
+The allow_deny method calls $self->double_reverse_lookup if
+double_reverse_lookups are enabled.
+
 The process then loops and waits for the next connection.  For a more
 in depth discussion, please read the code.
 
@@ -1253,6 +1312,13 @@ ip address, socket type, and hostname (as needed).
 This method uses the rules defined in the allow and deny configuration
 parameters to determine if the ip address should be accepted.
 
+=item C<$self-E<gt>double_reverse_lookup>
+
+Called if the double_reverse_lookups value is set or reverse_lookups
+is set to "double".  Uses peerhost_rev hashref ips to verify that the
+connection ip is valid for the hostname.  See the
+double_reverse_lookups configuration.
+
 =item C<$self-E<gt>process_request>
 
 This method is intended to handle all of the client communication.  At
openSUSE Build Service is sponsored by