[pve-devel] [PATCH] http-server: redirect HTTP to HTTPS

[Max Carrara <m.carrara@proxmox.com>]

Note: This change isn't final yet and shall only serve as an example.

This change adds another subroutine in the request processing
algorithm that verifies whether the TLS handshake has occurred
after the HTTP header was read, redirecting the user to HTTPS if
it hasn't.

In order to let AnyEvent handle TLS handshakes automatically,
the `tls_autostart` callback is added to the handle's read queue,
replacing the `tls` and `tls_ctx` constructor attributes.

Signed-off-by: Max Carrara <m.carrara@proxmox.com>
---
 src/PVE/APIServer/AnyEvent.pm | 115 ++++++++++++++++++++++++++++++----
 1 file changed, 102 insertions(+), 13 deletions(-)

diff --git a/src/PVE/APIServer/AnyEvent.pm b/src/PVE/APIServer/AnyEvent.pm
index 86f5e07..059d710 100644
--- a/src/PVE/APIServer/AnyEvent.pm
+++ b/src/PVE/APIServer/AnyEvent.pm
@@ -22,6 +22,7 @@ use Compress::Zlib;
 use Digest::MD5;
 use Digest::SHA;
 use Encode;
+use Errno qw(EBADMSG);
 use Fcntl ();
 use Fcntl;
 use File::Find;
@@ -1331,6 +1332,7 @@ sub begin_process_next_request {
 		my @process_steps = \(
 		    &parse_request_header_method,
 		    &parse_request_header_fields,
+                    &ensure_tls_connection,
 		    &postprocess_header_fields,
 		    &authenticate_and_handle_request,
 		);
@@ -1513,6 +1515,36 @@ sub parse_request_header_fields {
     return { success => 1 };
 }
 
+sub ensure_tls_connection {
+    my ($self, $reqstate) = @_;
+
+    $self->dprint("TLS session: " . $reqstate->{hdl}->{tls});
+    $self->dprint("TLS handshake succeeded: " . $reqstate->{tls_handshake_succeeded});
+
+    if ($reqstate->{hdl}->{tls} && $reqstate->{tls_handshake_succeeded}) {
+	return { success => 1 };
+    }
+
+    my $request = $reqstate->{request};
+    my $h_host = $reqstate->{request}->header('Host');
+
+    die "request object not found in reqstate\n"
+	if !$request;
+
+    die "Header field 'Host' not found in request\n"
+	if !$h_host;
+
+    my $secure_host = "https://" . ($h_host =~ s/^http(s)?:\/\///r);
+    my $h_location = $secure_host . $request->uri();
+
+    return {
+	success => 0,
+	http_code => 301,
+	http_message => 'Moved Permanently',
+	http_header => HTTP::Headers->new('Location' => $h_location),
+    };
+}
+
 sub postprocess_header_fields {
     my ($self, $reqstate) = @_;
 
@@ -1950,26 +1982,27 @@ sub accept_connections {
 		timeout => $self->{timeout},
 		linger => 0, # avoid problems with ssh - really needed ?
 		on_eof   => sub {
-		    my ($hdl) = @_;
-		    eval {
-			$self->log_aborted_request($reqstate);
-			$self->client_do_disconnect($reqstate);
-		    };
-		    if (my $err = $@) { syslog('err', $err); }
+		    $self->handle_on_eof($reqstate, @_);
 		},
 		on_error => sub {
-		    my ($hdl, $fatal, $message) = @_;
-		    eval {
-			$self->log_aborted_request($reqstate, $message);
-			$self->client_do_disconnect($reqstate);
-		    };
-		    if (my $err = $@) { syslog('err', "$err"); }
+		    $self->handle_on_error($reqstate, @_);
 		},
-		($self->{tls_ctx} ? (tls => "accept", tls_ctx => $self->{tls_ctx}) : ()));
+		on_starttls => sub {
+		    $self->handle_on_starttls($reqstate, @_);
+		},
+		on_stoptls => sub {
+		    $self->handle_on_stoptls($reqstate, @_);
+		}
+	    );
 	    $handle_creation = 0;
 
 	    $self->dprint("ACCEPT FH" .  $clientfh->fileno() . " CONN$self->{conn_count}");
 
+	    if ($self->{tls_ctx}) {
+		$self->dprint("Setting TLS to autostart");
+		$reqstate->{hdl}->unshift_read(tls_autostart => $self->{tls_ctx}, "accept");
+	    }
+
 	    $self->begin_process_next_request($reqstate);
 	}
     };
@@ -1991,6 +2024,62 @@ sub accept_connections {
     $self->wait_end_loop() if $self->{end_loop};
 }
 
+sub handle_on_eof {
+    my ($self, $reqstate, $handle) = @_;
+
+    eval {
+	$self->log_aborted_request($reqstate);
+	$self->client_do_disconnect($reqstate);
+    };
+
+    if (my $err = $@) { syslog('err', "$err"); }
+}
+
+sub handle_on_error {
+    my ($self, $reqstate, $handle, $fatal, $message) = @_;
+
+    $fatal ||= 0;
+    $message ||= '';
+
+    $self->dprint("Encountered error '$!' - fatal: $fatal; handle: $handle;");
+    $self->dprint("message: $message;");
+
+    eval {
+	if ($!{EBADMSG}) {
+	    $self->error($reqstate, 400, 'bad request');
+	} else {
+	    $self->dprint("Error '$!' not handled!");
+	}
+
+	$self->log_aborted_request($reqstate, $message);
+	$self->client_do_disconnect($reqstate);
+    };
+
+    if (my $err = $@) { syslog('err', "$err"); }
+}
+
+sub handle_on_starttls {
+    my ($self, $reqstate, $handle, $success, $message) = @_;
+
+    eval {
+	$reqstate->{tls_handshake_succeeded} = $success;
+
+	if ($success) {
+	    $self->dprint("TLS handshake for handle $handle successful ($message); session started");
+	} else {
+	    $self->dprint("TLS handshake for handle $handle failed");
+	}
+    };
+
+    if (my $err = $@) { syslog('err', "$err"); }
+}
+
+sub handle_on_stoptls {
+    my ($self, $reqstate, $handle) = @_;
+
+    $self->dprint("TLS session for handle $handle stopped");
+}
+
 # Note: We can't open log file in non-blocking mode and use AnyEvent::Handle,
 # because we write from multiple processes, and that would arbitrarily mix output
 # of all processes.
-- 
2.30.2