Keep the current ssl mode in links

diff --git a/PciIds/Html/Jump.pm b/PciIds/Html/Jump.pm
index 547000b6612b94249f6dcfe77350f7e6519f31c5..a693d56eac75add0c82b321731ce18747254879b 100644 (file)
--- a/PciIds/Html/Jump.pm
+++ b/PciIds/Html/Jump.pm
@@ -37,10 +37,10 @@ sub jumpWindow( $$ ) {
        print "</form>\n";
 }
 
-sub redirect( $$$ ) {
-       my( $req, $args, $addr ) = @_;
+sub redirect( $$$$ ) {
+       my( $req, $args, $addr, $hasSSL ) = @_;
        my $prefix = ( !defined $args->{'action'} || $args->{'action'} eq '' || $args->{'action'} eq 'list' ) ? 'read' : 'mods';
-       my $url = "http://".$req->hostname()."/$prefix/$addr".buildArgs( $args );
+       my $url = protoName( $hasSSL )."://".$req->hostname()."/$prefix/$addr".buildArgs( $args );
        return HTTPRedirect( $req, $url );
 }
 
@@ -49,8 +49,8 @@ sub itemExists( $$ ) {
        return defined $tables->item( $addr );
 }
 
-sub tryDirect( $$$$ ) {
-       my( $req, $args, $tables, $search ) = @_;
+sub tryDirect( $$$$$ ) {
+       my( $req, $args, $tables, $search, $hasSSL ) = @_;
        my $address = PciIds::Address::new( $req->uri() );
        $search =~ s/:/\//g;
        $search =~ s/ //g;
@@ -58,10 +58,10 @@ sub tryDirect( $$$$ ) {
        $search =~ s/^\//$top\//;
        #Is it absolute address?
        my $saddr = PciIds::Address::new( $search );
-       return redirect( $req, $args, $saddr->get() ) if( defined $saddr && itemExists( $tables, $saddr->get() ) );
+       return redirect( $req, $args, $saddr->get(), $hasSSL ) if( defined $saddr && itemExists( $tables, $saddr->get() ) );
        while( defined $address ) {
                $saddr = PciIds::Address::new( $address->get()."/$search" );
-               return redirect( $req, $args, $saddr->get() ) if( defined $saddr && itemExists( $tables, $saddr->get() ) );
+               return redirect( $req, $args, $saddr->get(), $hasSSL ) if( defined $saddr && itemExists( $tables, $saddr->get() ) );
                $address = $address->parent();
        }
        return undef;
@@ -72,7 +72,7 @@ sub jump( $$$$ ) {
        $args->{'action'} = delete $args->{'origin'};
        my $search = getFormValue( 'where', '' );
        my $idOnly = $search =~ s/^#//;
-       my $direct = tryDirect( $req, $args, $tables, $search );
+       my $direct = tryDirect( $req, $args, $tables, $search, $auth->{'ssl'} );
        return $direct if defined $direct;
        my $address = PciIds::Address::new( $req->uri() );
        unless( $idOnly || length $search < 3 ) {#Try extended search
@@ -89,7 +89,7 @@ sub jump( $$$$ ) {
                        genPath( $req, $address, 1 );
                        print "<h2>Found items</h2>\n";
                        genTableHead( 'found', [ 'ID', 'Name', 'Parent' ], [] );
-                       my $prefix = 'http://'.$req->hostname().'/'.( ( !defined $args->{'action'} || $args->{'action'} eq '' || $args->{'action'} eq 'list' ) ? 'read/' : 'mods/' );
+                       my $prefix = $req->hostname().'/'.( ( !defined $args->{'action'} || $args->{'action'} eq '' || $args->{'action'} eq 'list' ) ? 'read/' : 'mods/' );
                        my $suffix = buildArgs( $args );
                        htmlFormatTable( $result, 3, [], [ sub {
                                my $addr = shift;

diff --git a/PciIds/Html/Users.pm b/PciIds/Html/Users.pm
index 119144846573c0cab24ba46f5fcd27c13b0fa605..dab07004e576dc5a0f69a782d092d4b7c4bd6225 100644 (file)
--- a/PciIds/Html/Users.pm
+++ b/PciIds/Html/Users.pm
@@ -224,7 +224,7 @@ sub loginSubmit( $$$ ) {
        if( $logged ) {
                $req->err_headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, undef, $email ) ) );
                $args->{'action'} = ( defined $args->{'redirectaction'} && $args->{'redirectaction'} ne '' ) ? $args->{'redirectaction'} : 'list';
-               my $url = 'http://'.$req->hostname().setAddrPrefix( $req->uri(), $args->{'action'} eq 'list' ? 'read' : 'mods' ).buildExcept( 'redirectaction', $args );
+               my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), $args->{'action'} eq 'list' ? 'read' : 'mods' ).buildExcept( 'redirectaction', $args );
                return HTTPRedirect( $req, $url );
        } else {
                return genLoginForm( $req, $args, 'Invalid login credetials', $data );

diff --git a/PciIds/Html/Util.pm b/PciIds/Html/Util.pm
index 41c2c8b6a0c17190e59afc76426ead0864544afc..608a4f7c3e36d09476ca8b7b47a21137642077cd 100644 (file)
--- a/PciIds/Html/Util.pm
+++ b/PciIds/Html/Util.pm
@@ -25,12 +25,17 @@ use PciIds::Users;
 use Apache2::Const qw(:common :http);
 use APR::Table;
 
-our @EXPORT = qw(&genHtmlHead &htmlDiv &genHtmlTail &genTableHead &genTableTail &parseArgs &buildExcept &buildArgs &genMenu &genCustomMenu &encode &setAddrPrefix &HTTPRedirect &genPath &logItem &genLocMenu &genCustomHead &genPathBare);
+our @EXPORT = qw(&genHtmlHead &htmlDiv &genHtmlTail &genTableHead &genTableTail &parseArgs &buildExcept &buildArgs &genMenu &genCustomMenu &encode &setAddrPrefix &HTTPRedirect &genPath &logItem &genLocMenu &genCustomHead &genPathBare &protoName);
 
 sub encode( $ ) {
        return encode_entities( shift, "\"'&<>" );
 }
 
+sub protoName( $ ) {
+       my( $hasSSL ) = ( @_ );
+       return 'http' . ( 's' x $hasSSL );
+}
+
 sub genHtmlHead( $$$ ) {
        my( $req, $caption, $metas ) = @_;
        $req->content_type( 'text/html; charset=utf-8' );
@@ -78,7 +83,7 @@ sub genCustomMenu( $$$$ ) {
                        $prefix = '/read' if( !defined( $action ) or ( $action eq 'list' ) or ( $action eq '' ) or ( $action eq 'help' ) );
                        my $suffix = '';
                        $suffix = '?help='.$param if( $action eq 'help' );
-                       item( 'http://'.$req->hostname().$prefix.$url.$action.$suffix, $label );
+                       item( $prefix.$url.$action.$suffix, $label );
                }
        }
        print "</ul>\n";
@@ -192,7 +197,7 @@ sub genPathBare( $$$$ ) {
                if( !$printAddr && $myAddr ) {
                        print "<strong>".encode( $addr->pretty() )."</strong>";
                } else {
-                       print "<a href='http://".$req->hostname()."/read/".$addr->get()."'>".encode( $addr->pretty() )."</a>";
+                       print "<a href='/read/".$addr->get()."'>".encode( $addr->pretty() )."</a>";
                }
                print ")" if( $exception );
        }
@@ -201,7 +206,7 @@ sub genPathBare( $$$$ ) {
 sub genPath( $$$ ) {
        my( $req, $address, $printAddr ) = @_;
        print "<div class='path'>\n";
-       print "<p><a href='http://".$req->hostname()."/index.html'>Main</a>";
+       print "<p><a href='/index.html'>Main</a>";
        genPathBare( $req, $address, $printAddr, 1 );
        print "</div>\n";
 }