Funktionen zum Verschluesseln des Passortes und zum Ueberpruefen dazu

git-svn-id: http://svn.brehm-online.com/svn/my-stuff/dyndns/trunk@18 ec8d2aa5-1599-4edb-8739-2b3a1bc399aa

diff --git a/cgi-bin/set.pl b/cgi-bin/set.pl
index 8f88c68042c7024ac5d089b54d273775bf5b0582..a8dec89cb14a60fb5a204bf2fde315e6b4f1546d 100755 (executable)
--- a/cgi-bin/set.pl
+++ b/cgi-bin/set.pl
@@ -9,6 +9,7 @@ use warnings;
 use CGI;
 use Net::DNS;
 use FindBin;
+use Readonly;
 use Cwd qw( abs_path );
 
 $| = 1;
@@ -19,13 +20,15 @@ unless ( -d $log_dir ) {
     die "Logverzeichnis '" . $log_dir . "' nicht gefunden.\n";
 }
 $log_dir = abs_path($log_dir);
-my $logfile = $log_dir . "/set.log";
+my $logfile  = $log_dir . "/set.log";
 my $errorlog = $log_dir . "/set.error.log";
 
-my $account     = $q->param('account') || '';
-my $passwd      = $q->param('passwd') || '';
-my $host        = $q->param('host') || '';
-my $do_mx       = $q->param('do_mx');
+Readonly::Scalar my $use_md5 => 1;
+
+my $account = $q->param('account') || '';
+my $passwd  = $q->param('passwd')  || '';
+my $host    = $q->param('host')    || '';
+my $do_mx   = $q->param('do_mx');
 my $do_wildcard = $q->param('do_wildcard');
 my $output_type = $q->param('output_type');
 my $test        = $q->param('test');
@@ -35,9 +38,9 @@ my $success = ( $account eq 'uhu' and $passwd eq 'banane' and $host eq 'home.dyn
 my $reason = 'Ungültige Angaben.';
 
 my $ip = $ENV{'REMOTE_ADDR'};
-unless ( $ip ) {
+unless ($ip) {
     $success = 0;
-    $reason = 'Wurde nicht als CGI-Anwendung gestartet.';
+    $reason  = 'Wurde nicht als CGI-Anwendung gestartet.';
 }
 
 my $title = 'Dyn-DNS-Eintrag';
@@ -46,8 +49,9 @@ if ( $success and not $test ) {
 
     my $domain = 'dyn.brehm-online.com';
     my $update = Net::DNS::Update->new($domain);
-    $update->push( 'update' => rr_del( $host ) );
-    $update->push( 'update' => rr_add( $host  . ". " . $ttl . " A " . $ip ) );
+    $update->push( 'update' => rr_del($host) );
+    $update->push( 'update' => rr_add( $host . ". " . $ttl . " A " . $ip ) );
+
     #$update->push( 'update' => rr_add( '*.' . $host  . ". " . $ttl . " A " . $ip ) ) if $do_wildcard;
     #$update->push( 'update' => rr_add( $host  . ". " . $ttl . " MX 10 " . $host . "." ) ) if $do_mx;
 
@@ -58,16 +62,17 @@ if ( $success and not $test ) {
 
     # Did it work?
     if ($reply) {
-        unless ($reply->header->rcode eq 'NOERROR') {
-            $reason = 'Update fehlgeschlagen: ' . $reply->header->rcode;
+        unless ( $reply->header->rcode eq 'NOERROR' ) {
+            $reason  = 'Update fehlgeschlagen: ' . $reply->header->rcode;
             $success = 0;
         }
-    } else {
-        $reason = 'Update fehlgeschlagen: ' . $reply->errorstring;
+    }
+    else {
+        $reason  = 'Update fehlgeschlagen: ' . $reply->errorstring;
         $success = 0;
     }
 
-}
+} ## end if ( $success and not $test )
 
 print $q->header(
     '-type'    => 'text/html',
@@ -76,44 +81,139 @@ print $q->header(
 );
 
 print $q->start_html(
-    '-title'  => $title,
-    '-author' => 'frank@brehm-online.com',
-    '-meta'   => {
-        'copyright' => 'copyright 2008 Frank Brehm'
-    },
-    '-style' => {
-        'src'=>'/styles/style1.css'
-    },
+    '-title'   => $title,
+    '-author'  => 'frank@brehm-online.com',
+    '-meta'    => { 'copyright' => 'copyright 2008 Frank Brehm' },
+    '-style'   => { 'src' => '/styles/style1.css' },
     '-BGCOLOR' => 'white',
     '-TEXT'    => 'navy',
 );
 
 print $q->h1($title) . "\n";
-if ( $success ) {
+if ($success) {
     print $q->h2( sprintf( "Die Anmeldung von Host '%s' mit der IP '%s' war ERFOLGREICH.", $host, $ip ) ) . "\n";
 }
 else {
-    print $q->h2( "Die Anmeldung war NICHT erfolgreich." ) . "\n";
-    print $q->dl( $q->dt( $q->b( "Grund:" ) ) . "\n" . $q->dd($reason) . "\n" ) . "\n";
+    print $q->h2("Die Anmeldung war NICHT erfolgreich.") . "\n";
+    print $q->dl( $q->dt( $q->b("Grund:") ) . "\n" . $q->dd($reason) . "\n" ) . "\n";
 }
 
-if ( $success ) {
+if ($success) {
     if ( open LOG, ">>", $logfile ) {
-        printf LOG "[%s]: Host '%s' mit IP '%s' für '%s' angemeldet.\n", scalar(localtime()), $host, $ip, $account;
+        printf LOG "[%s]: Host '%s' mit IP '%s' für '%s' angemeldet.\n", scalar( localtime() ), $host, $ip, $account;
         close LOG;
     }
     else {
         warn "Konnte Log '" . $logfile . "' nicht zum Schreiben oeffnen: " . $!;
     }
 }
-elsif ( $ip ) {
+elsif ($ip) {
     if ( open LOG, ">>", $errorlog ) {
-        printf LOG "[%s]: Remote Host '%s' mit Fehlern: Host '%s', Account '%s', Passwort '%s', Grund '%s'.\n", scalar(localtime()), $ip, $host, $account, $passwd, $reason;
+        printf LOG "[%s]: Remote Host '%s' mit Fehlern: Host '%s', Account '%s', Passwort '%s', Grund '%s'.\n", scalar( localtime() ), $ip,
+            $host, $account, $passwd, $reason;
         close LOG;
     }
     else {
         warn "Konnte Log '" . $errorlog . "' nicht zum Schreiben oeffnen: " . $!;
     }
-}
+} ## end elsif ($ip)
 
 print $q->end_html() . "\n";
+
+#------------------------------------------------------------------------
+
+sub check_password {
+
+    my $pass      = shift;
+    my $cryptPass = shift;
+
+    my $MD5Magic  = '$apr1$';
+    my $SHA1Magic = '{SHA}';
+
+    if ( !$cryptPass ) {
+        return undef;
+    }
+
+    if ( index( $cryptPass, $MD5Magic ) == 0 ) {
+
+        # This is an MD5 password
+        require Crypt::PasswdMD5;
+        my $salt = $cryptPass;
+        $salt =~ s/^\Q$MD5Magic//;    # Take care of the magic string if present
+        $salt =~ s/^(.*)\$/$1/;       # Salt can have up to 8 chars...
+        $salt = substr( $salt, 0, 8 );    # That means no more than 8 chars too.
+        return 1 if Crypt::PasswdMD5::apache_md5_crypt( $pass, $salt ) eq $cryptPass;
+    } ## end if ( index( $cryptPass, $MD5Magic ) == 0 )
+    elsif ( index( $cryptPass, $SHA1Magic ) == 0 ) {
+
+        # This is an SHA1 password
+        require Digest::SHA1;
+        require MIME::Base64;
+        return 1 if '{SHA}' . MIME::Base64::encode_base64( Digest::SHA1::sha1($pass), '' ) eq $cryptPass;
+    }
+
+    # See if it is encrypted using crypt
+    return 1 if crypt( $pass, $cryptPass ) eq $cryptPass;
+
+    # See if it is a plain, unencrypted password
+    return 1 if $pass eq $cryptPass;
+
+    return 0;
+
+} ## end sub check_password
+
+#-----------------------------------------------------------#
+
+sub crypt_passwd {
+
+    my $passwd    = shift;
+    my $salt      = shift;
+    my @chars     = ( '.', '/', 0 .. 9, 'A' .. 'Z', 'a' .. 'z' );
+    my $Magic     = '$apr1$';                                             # Apache specific Magic chars
+    my $cryptType = ( $^O =~ /^MSWin/i || $use_md5 ) ? "MD5" : "crypt";
+
+    if ( $salt && $cryptType =~ /MD5/i && $salt =~ /^\Q$Magic/ ) {
+
+        # Borrowed from Crypt::PasswdMD5
+        $salt =~ s/^\Q$Magic//;                                           # Take care of the magic string if present
+        $salt =~ s/^(.*)\$.*$/$1/;                                        # Salt can have up to 8 chars...
+        $salt = substr( $salt, 0, 8 );                                    # That means no more than 8 chars too.
+                                                                          # For old crypt only
+    }
+    elsif ( $salt && $cryptType =~ /crypt/i ) {
+        if ( $salt =~ /\$2a\$\d+\$(.{23})/ ) {
+            $salt = $1;
+        }
+        else {
+
+            # Make sure only use 2 chars
+            $salt = substr( $salt, 0, 2 );
+        }
+    } ## end elsif ( $salt && $cryptType =~ /crypt/i )
+    else {
+
+        # If we use MD5, create apache MD5 with 8 char salt: 3 randoms, 5 dots
+        if ( $cryptType =~ /MD5/i ) {
+            $salt = join( '', map { $chars[ int rand @chars ] } ( 0 .. 2 ) ) . "." x 5;
+
+            # Otherwise fallback to standard archaic crypt
+        }
+        else {
+            $salt = join( '', map { $chars[ int rand @chars ] } ( 0 .. 1 ) );
+        }
+    } ## end else [ if ( $salt && $cryptType =~ /MD5/i && $salt...
+
+    if ( $cryptType =~ /MD5/i ) {
+        require Crypt::PasswdMD5;
+        return Crypt::PasswdMD5::apache_md5_crypt( $passwd, $salt );
+    }
+    else {
+        return crypt( $passwd, $salt );
+    }
+
+} ## end sub crypt_passwd
+
+__END__
+
+#-----------------------------------------------------------#
+