view release on metacpan or  search on metacpan

lib/App/TLSMe.pm  view on Meta::CPAN

                if ($error =~ m/ssl23_get_client_hello: http request/) {
                    my $response = $self->_build_http_response(
                        '501 Not Implemented',
                        '<h1>501 Not Implemented</h1>'
                          . '<p>Try <code>https://</code> instead of <code>http://</code>?</p>'
                    );

                    syswrite $fh, $response;
                }

                $self->_log(
                    "Closing connection from $peer_host:$peer_port: $error");

                $self->{pool}->remove_connection($fh);
            },
            on_backend_connected => sub {
                $self->_log("Connected to backend");
            },
            on_backend_eof => sub {
                $self->_log("Disconnected from backend");
            },
            on_backend_error => sub {
                my ($conn, $message) = @_;

                $self->_log("Disconnected from backend: $message");

                my $response = $self->_build_http_response('502 Bad Gateway',
                    '<h1>502 Bad Gateway</h1>');

                $conn->write($response);
            }
        );
    };
}

sub _bind_handler {
    my $self = shift;

    return sub {
        my ($fh, $host, $port) = @_;

        $self->_log("Listening on $host:$port");

        $self->_drop_privileges;

        return $self->{backlog} || 128;
    };
}

sub _drop_privileges {
    my $self = shift;

    if ($self->{user}) {
        $self->_log('Dropping privileges');

        eval { require Privileges::Drop; 1 }
          or do { die "Privileges::Drop is required\n" };

        if ($self->{group}) {
            Privileges::Drop::drop_uidgid($self->{user}, $self->{group});
        }
        else {
            Privileges::Drop::drop_privileges($self->{user});
        }
    }
}

sub _build_http_response {
    my $self = shift;
    my ($status_message, $body) = @_;

    my $length = length($body);

    return join "\015\012", "HTTP/1.1 $status_message",
      "Content-Length: $length", "", $body;
}

sub _log {
    my $self = shift;

    return unless $self->{logger};

    $self->{logger}->log(@_);
}

sub _build_logger {
    my $self = shift;
    my ($log) = @_;

    my $fh;
    if ($log) {
        open $fh, '>>', $log or die "Can't open log file '$log': $!";
    }

    return App::TLSMe::Logger->new(fh => $fh);
}

1;
__END__

=head1 NAME

App::TLSMe - TLS/SSL tunnel

=head1 SYNOPSIS

    App::TLSMe->new(
        listen    => ':443',
        backend   => '127.0.0.1:8080',
        cert_file => 'cert.pem',
        key_file  => 'key.pem'
    )->run;

Run C<tlsme -h> for more options.

=head1 DESCRIPTION

This module is used by a command line application C<tlsme>. You might want to
look at its documentation instead.