This file is indexed.

/usr/share/perl5/HTTP/Daemon/SSL.pm is in libhttp-daemon-ssl-perl 1.04-3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
#
# This package derived almost entirely from HTTP::Daemon,
# owned by Gisle Aas.  Changes include minor alterations in
# the documentation to reflect the use of IO::Socket::SSL
# and modified new(),accept() functions that use IO::Socket::SSL

use strict;

package HTTP::Daemon::SSL;

=head1 NAME

HTTP::Daemon::SSL - a simple http server class with SSL support

=head1 SYNOPSIS

  use HTTP::Daemon::SSL;
  use HTTP::Status;

  # Make sure you have a certs/ directory with "server-cert.pem"
  # and "server-key.pem" in it before running this!
  my $d = HTTP::Daemon::SSL->new || die;
  print "Please contact me at: <URL:", $d->url, ">\n";
  while (my $c = $d->accept) {
      while (my $r = $c->get_request) {
	  if ($r->method eq 'GET' and $r->url->path eq "/xyzzy") {
              # remember, this is *not* recommened practice :-)
	      $c->send_file_response("/etc/passwd");
	  } else {
	      $c->send_error(RC_FORBIDDEN)
	  }
      }
      $c->close;
      undef($c);
  }

=head1 DESCRIPTION

Instances of the I<HTTP::Daemon::SSL> class are HTTP/1.1 servers that
listen on a socket for incoming requests. The I<HTTP::Daemon::SSL> is a
sub-class of I<IO::Socket::SSL>, so you can perform socket operations
directly on it too.

The accept() method will return when a connection from a client is
available.  In a scalar context the returned value will be a reference
to a object of the I<HTTP::Daemon::ClientConn::SSL> class which is another
I<IO::Socket::SSL> subclass.  In a list context a two-element array
is returned containing the new I<HTTP::Daemon::ClientConn::SSL> reference
and the peer address; the list will be empty upon failure. (Note that version
 1.02 erroneously did not honour list context). Calling
the get_request() method on the I<HTTP::Daemon::ClientConn::SSL> object
will read data from the client and return an I<HTTP::Request> object
reference.

This HTTPS daemon does not fork(2) for you.  Your application, i.e. the
user of the I<HTTP::Daemon::SSL> is reponsible for forking if that is
desirable.  Also note that the user is responsible for generating
responses that conform to the HTTP/1.1 protocol.  The
I<HTTP::Daemon::ClientConn> class provides some methods that make this easier.

=head1 METHODS

The following methods are the only differences from the I<HTTP::Daemon> base class:

=over 4

=cut


use vars qw($VERSION @ISA $PROTO $DEBUG);

use IO::Socket::SSL;
use HTTP::Daemon;

$VERSION = "1.04";
@ISA = qw(IO::Socket::SSL HTTP::Daemon);

=item $d = new HTTP::Daemon::SSL

The constructor takes the same parameters as the
I<IO::Socket::SSL> constructor.  It can also be called without specifying
any parameters, but you will have to make sure that you have an SSL certificate
and key for the server in F<certs/server-cert.pem> and F<certs/server-key.pem>.
See the IO::Socket::SSL documentation for how to change these default locations
and specify many other aspects of SSL behavior. The daemon will then set up a
listen queue of 5 connections and allocate some random port number.  A server
that wants to bind to some specific address on the standard HTTPS port will be
constructed like this:

  $d = new HTTP::Daemon::SSL
        LocalAddr => 'www.someplace.com',
        LocalPort => 443;

=cut

sub new
{
    my ($class, %args) = @_;
    $args{Listen} ||= 5;
    $args{Proto} ||= 'tcp';
    $args{SSL_error_trap} ||= \&ssl_error;
    return $class->SUPER::new(%args);
}

sub accept
{
    my $self = shift;
    my $pkg = shift || "HTTP::Daemon::ClientConn::SSL";
	my ($sock, $peer) = IO::Socket::SSL::accept($self,$pkg);
    if ($sock) {
        ${*$sock}{'httpd_daemon'} = $self;
        return wantarray ? ($sock, $peer) : $sock;
    }
    else {
        return;
    }
}

sub _default_port { 443; }
sub _default_scheme { "https"; }

sub url
{
    my $self = shift;
    my $url = $self->SUPER::url;
    return $url if ($self->can("HTTP::Daemon::_default_port"));
    
    # Workaround for old versions of HTTP::Daemon
    $url =~ s!^http:!https:!;
    $url =~ s!/$!:80/! unless ($url =~ m!:(?:\d+)/$!);
    $url =~ s!:443/$!/!;
    return $url;
}


package HTTP::Daemon::SSL::DummyDaemon;
use vars qw(@ISA);
@ISA = qw(HTTP::Daemon);
sub new { bless [], shift; }

package HTTP::Daemon::SSL;

sub ssl_error {
    my ($self, $error) = @_;
    ${*$self}{'httpd_client_proto'} = 1000;
    ${*$self}{'httpd_daemon'} = new HTTP::Daemon::SSL::DummyDaemon;
    if ($error =~ /http/i and $self->opened) {
	$self->send_error(400, "Your browser attempted to make an unencrypted\n ".
		      "request to this server, which is not allowed.  Try using\n ".
		      "HTTPS instead.\n");
    }
    $self->kill_socket;
}

# we're not overriding any methods here, but we are inserting IO::Socket::SSL
# into the message dispatch tree

package HTTP::Daemon::ClientConn::SSL;
use vars qw(@ISA $DEBUG);
@ISA = qw(IO::Socket::SSL HTTP::Daemon::ClientConn);
*DEBUG = \$HTTP::Daemon::DEBUG;


=back

=head1 SEE ALSO

RFC 2068

L<IO::Socket::SSL>, L<HTTP::Daemon>, L<Apache>

=head1 COPYRIGHT

Code and documentation from HTTP::Daemon Copyright 1996-2001, Gisle Aas
Changes Copyright 2003-2004, Peter Behroozi

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

1;