newlogon 3.91 KB
Newer Older
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
#!/usr/bin/perl
sub BEGIN { $ENV{PTKDB_STOP_TAG_COLOR} = "yellow" } 
#
# TWiki WikiClone (see wiki.pm for $wikiversion and other info)
#
# Copyright (C) 1999 Peter Thoeny, peter@thoeny.com
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details, published at 
# http://www.gnu.org/copyleft/gpl.html

use CGI::Carp qw(fatalsToBrowser);
use CGI;
use lib ( '.' );
use lib ( '../lib' );
use TWiki;
use TWiki::Plugins::SessionPlugin;

26
my $oopsurl = "oopsloginfail";
27
my $CREDDIR = "/var/db/cgisess";
28 29 30

$query= new CGI;

31 32 33 34 35 36 37 38
sub myerror($)
{
    my ($msg) = @_;

    my $url = &TWiki::getOopsUrl(undef, "", $oopsurl, $msg);
    TWiki::redirect($query, $url);
}

39 40 41 42 43 44
&main();

sub main
{
    my $username = $query->param('username');
    my $password = $query->param('password');
45
    my $redurl   = $query->param('redurl');
46
    my $bosscred = $query->param('bosscred');
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
    #
    # If bosscred provided, boss is trying to autologin the user using
    # a key that it sent across via a backend script and stashed in the
    # cookie dir. Find that file, compare the keys and if the key is not
    # too terribly old, give the user the nod.
    #
    if (defined($bosscred)) {
	if (!defined($username) || $username eq "") {
	    myerror("Missing username argument");
	    return;
	}

	my $file = "${CREDDIR}/$username";

	if (! -e $file) {
	    myerror("Cred file does not exist!");
	    return;
	}
	if (!open(COK, $file)) {
	    myerror("Cannot open cred file!");
	    return;
	}
	my $cred  = <COK>;
	my $stamp = <COK>;
	close(COK);

	# Compare credentials.
	if (defined($cred)) {
	    chomp($cred);
	    if ($cred eq $bosscred) {
		goto accepted;
	    }
	}
	# Does not match. Redirect to login page.
      dologon:
	my $url = &TWiki::getViewUrl("TWiki", "DoLogin");
	$url .= "?username=${username}";
	$url .= "&redurl=${redurl}"
	    if (defined($redurl) && $redurl ne "");
	
	TWiki::redirect($query, $url);
	return;
    }
91

92 93 94
    #
    # Normal login.
    # 
95
    if (! ($username && $password)) {
96
	myerror("Missing arguments (username or password)");
97 98
	return;
    }
99 100
    chomp($username);
    chomp($password);
101 102 103 104 105 106

    #
    # Suck out the password entry.
    #
    my $pwentry;
    
107 108
    open(HTP, $TWiki::htpasswdFilename) or
	die("Could not open $TWiki::htpasswdFilename\n");
109 110 111 112 113 114 115 116 117 118

    while (<HTP>) {
	if ($_ =~ /^${username}:.*$/) {
	    $pwentry = $_;
	    last;
        }
    }
    close(HTP);

    if (!defined($pwentry)) {
119
	myerror("No such user: '$username'");
120 121 122 123 124 125 126 127 128
	return;
    }

    #
    # Split up the entry and compare.
    #
    my ($wikiname, $encryptedpasswd) = split(":", $pwentry);
    chomp($encryptedpasswd);

129
    my $str = crypt($password, $encryptedpasswd);
130 131

    if ($str ne $encryptedpasswd) {
132
	myerror("Incorrect Password");
133 134
	return;
    }
135
 
136 137
    # This causes the query object to suddenly have a remote_user() value.
    # SessionPlugin uses that ...
138 139
 accepted:
   $ENV{REMOTE_USER} = $username;
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161

    #
    # Stuff we need to pass down. Note that I am not bothering with the
    # topic cause of how this script will typically be invoked. 
    #
    my $thePathInfo = $query->path_info(); 
    my $theRemoteUser = $query->remote_user();
    my $theUrl = $query->url;
    my $theTopic = (defined($redurl) ? $redurl : "");

    # This appears to be necessary.
    $query->delete_all();

    my ($topic, $webName) = 
        &TWiki::initialize($thePathInfo, $theRemoteUser,
			   $theTopic, $theUrl, $query);

    my $url = &TWiki::getViewUrl($webName, $topic);

    $url .= ( '?' . $query->query_string() ) if $query->query_string();

    &TWiki::redirect( $query, $url );
162
}