File: poppass

package info (click to toggle)
poppass-cgi 3-4
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 64 kB
  • ctags: 5
  • sloc: perl: 121; makefile: 45; sh: 20
file content (148 lines) | stat: -rwxr-xr-x 5,432 bytes parent folder | download | duplicates (4)
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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
#!/usr/local/bin/perl

# PopPass - a CGI script in Perl to allow users to changes their password
# using a WWW interface. PopPass uses poppassd version 1.2 (available at
# ftp://ftp.qualcomm.com/eudora/servers/unix/password/ to actually make 
# the password change. It can therefore run as an unprivilaged user on any 
# server (not necessarly the server where the password file exists). The 
# Perl 5 modules IO::Socket and CGI are also required (available from your 
# favorite CPAN site).
# A version of poppassd for Linux systems using shadow passwords can be
# found at ftp://ftp.ceti.com.pl/pub/linux/poppassd-1.8-ceti.tar.gz
# ==========================================================================
# Created: 2 Feb 96 by Jerry Workman (jerry@mtnsoft.com)
# Last Revised: 19 January 2000
# ==========================================================================
use strict;
use CGI qw(:all);	# CGI forms etc
use CGI::Carp qw(fatalsToBrowser set_message);
BEGIN {
  sub handle_errors {
    my $msg = shift;
    print "<h2>Error:</H2><i>$msg</i>";
  }
  set_message(\&handle_errors);
}
$SIG{ALRM} = \&error_exit;
alarm(60);
open(STDERR,">&STDOUT") || die "Can't dup stdout: $!\n";
select(STDERR); $| = 1; # Make unbuffered.
select(STDOUT); $| = 1; # Make unbuffered.
# --------------------------------------------------------------------------
my $DEBUG		= 0;
my $DEFAULTHOST	= 'localhost';	# host name if different from web server
my $TITLE		= 'Change Your Password';
my $AUTHOR		= 'Jerry Workman';
my $COPYRIGHT	= "Copyright 1996-2000 $AUTHOR";
my $HOME		= hr. a({href=>"/"}, "Home"); # Very Basic Home link
my $MESSAGE	= <<EOM;
Enter your UserName, current password, and new password (twice for
verification) then click on Change Password. Passwords must be
at least 6 characters and can be mixed case.
EOM
# ** End of Configurable Parameters (unless you're a Perl hacker) **
# --------------------------------------------------------------------------
my $host 		= param('host') || $DEFAULTHOST;
my $username 	= param('username');
my $password 	= param('password');
my $newpassword1 	= param('newpassword1');
my $newpassword2 	= param('newpassword2');
my $msg;
# --------------------------------------------------------------------------
print header, 
      start_html(-title=>$TITLE,
                 -author=>$AUTHOR,
                 -base=>'true',
                 -meta=>{'copyright'=>$COPYRIGHT});
print CGI::dump() if $DEBUG;
if(!param()) {
  showform();
} else {
  error_exit("You must supply a Username") 
    if (!$username);
  error_exit("New Passwords do not match") 
    if ($newpassword1 ne $newpassword2);
  error_exit("The New Password can not be blank") 
    if length($newpassword1) == 0;
  my $newpassword = $newpassword1;
  error_exit("New Password can not contain spaces") 
    if $newpassword =~ / /;
  error_exit ("Password must be six or more characters")
    if length($newpassword) < 6;
  if(poppass($host, $username, $password, $newpassword)) {
    print p, center(h2("Password Changed Successfully")), "\n";
  } else {
    error_exit($msg);
  }
  print hr, "<I>Be sure to change your password in both your dialer" .
            " and E-mail programs</I>";
}
print $HOME, end_html;
# --------------------------------------------------------------------------
# Subroutines
# --------------------------------------------------------------------------
sub showform {
  print p, blockquote(center(h2('Change Password')), hr, 
    $MESSAGE, hr, center(pre(startform(),
    "<b>           UserName: </b>", textfield('username','', 25), "\n",
    "<b>       Old Password: </b>", password_field('password','', 25), "\n",
    "<b>       New Password: </b>", password_field('newpassword1','',25),"\n",
    "<b>Verify New Password: </b>", password_field('newpassword2','',25),"\n\n",
    submit('action','Change Password'),
    endform))), "\n";
}
# --------------------------------------------------------------------------
sub error_exit {
  my($msg) = @_;
  print h1("Error:"), h2($msg), hr,
       "Return to the previous page and make the necessary corrections",
       $HOME, end_html;
  exit;
}
# --------------------------------------------------------------------------
# Change the password using service poppassd at port 106
#
sub poppass
{
  my($host, $username, $password, $newpassword) = @_;
  my ($status, $socket) = 0;
  eval {
	sub popout {
		my $str = shift;
		print $socket "$str\n";
		print "$str <br>\n" if $DEBUG;
	}
	use IO::Socket::INET;
	$socket = IO::Socket::INET->new(
		PeerAddr => $host,
		PeerPort => 106, 
		Proto    => 'tcp',
		Type	 => SOCK_STREAM) or
		( $msg = "No Response from poppass server:$@\n", return $status = 0 );

	while ($_ = <$socket>) {
		s/\n//g;
		s/\r//g;
		print "$_ <br>\n" if $DEBUG;
		/200 poppassd/ && 
			(popout("USER $username"), next );
		/200.*[Yy]our password please/ && 
			(popout("PASS $password"), next );
		/200.*new password/ &&
			(popout("NEWPASS $newpassword"), next );
		/200 Password changed/ && 
			( $msg = "Password successfully changed", $status = 1, last );
		/200 Bye/ && 
			(popout("QUIT"), last );
		/500/ && ( s/500//, $msg = $_, $status = undef, last );
		// && ( $msg = "No Response from server", $status = 0, last );
	}
    close($socket);
  }; #eval
	if ($@) {
		($msg) = split(/:/, $@);
		$msg =~ /[Tt]imeout/ && ($msg = "poppassd server not responding, try again later.");
		$status = 0;
	}
	return $status;
}