Diff -- /var/www/vhosts/webstls.com/httpdocs/password_change.cgi
Diff

/var/www/vhosts/webstls.com/httpdocs/password_change.cgi

added on WebSTLs (webstls.com) at 2026-07-01 22:26:44

Added
+126
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 7f5264c5ba9c
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1#!/usr/bin/perl
2#======================================================================
3# WebSTLs -- self-service password change.
4#
5# GET /password_change.cgi -> render form
6# POST /password_change.cgi -> verify current pw, set new
7#
8# The POST path uses Login::update_password which both rehashes and
9# revokes every other active session, so an attacker holding a stolen
10# cookie loses access the moment the legit owner rotates their pw.
11#======================================================================
12use strict;
13use warnings;
14
15use lib '/var/www/vhosts/webstls.com/httpdocs';
16use CGI;
17use MODS::Template;
18use MODS::DBConnect;
19use MODS::Login;
20use MODS::WebSTLs::Config;
21use MODS::WebSTLs::Wrapper;
22
23$|=1;
24
25my $q = CGI->new;
26my $form = $q->Vars;
27my $auth = MODS::Login->new;
28my $tfile = MODS::Template->new;
29my $db = MODS::DBConnect->new;
30my $cfg = MODS::WebSTLs::Config->new;
31my $wrap = MODS::WebSTLs::Wrapper->new;
32my $DB = $cfg->settings('database_name');
33
34my $userinfo = $auth->login_verify();
35unless ($userinfo) {
36 print "Status: 302 Found\nLocation: /login.cgi\n\n";
37 exit;
38}
39my $uid = $userinfo->{user_id};
40$uid =~ s/[^0-9]//g;
41
42my $err = '';
43
44if (($ENV{REQUEST_METHOD} || '') eq 'POST') {
45 my $cur = $form->{current_password} // '';
46 my $nw = $form->{new_password} // '';
47 my $cf = $form->{new_password_again} // '';
48
49 if (!length($cur)) {
50 $err = 'Current password is required.';
51 }
52 elsif (length($nw) < 8) {
53 $err = 'New password must be at least 8 characters.';
54 }
55 elsif ($nw ne $cf) {
56 $err = 'New passwords do not match.';
57 }
58 elsif ($nw eq $cur) {
59 $err = 'New password must be different from your current one.';
60 }
61 else {
62 # Pull the stored hash, verify the supplied current password
63 # against it. Login::_verify_password handles both Argon2 and
64 # the SHA fallback shape.
65 my $dbh = $db->db_connect();
66 my $u = $db->db_readwrite($dbh, qq~
67 SELECT password_hash FROM `${DB}`.users WHERE id='$uid' LIMIT 1
68 ~, $ENV{SCRIPT_NAME}, __LINE__);
69 $db->db_disconnect($dbh);
70
71 unless ($u && length($u->{password_hash} // '')
72 && MODS::Login::_verify_password($cur, $u->{password_hash})) {
73 $err = 'Current password is incorrect.';
74 }
75 else {
76 # update_password rotates the hash AND revokes every other
77 # active session. Mint a fresh session for THIS browser via
78 # login_exec so the user does not get bounced to the login
79 # page on the redirect that follows.
80 if ($auth->update_password($uid, $nw)) {
81 my ($new_userinfo, $new_token) =
82 $auth->login_exec($userinfo->{email}, $nw);
83 if ($new_token) {
84 my $cookie_line = $auth->set_cookie_header($new_token);
85 print "Status: 302 Found\n$cookie_line\nLocation: /profile.cgi?pw_changed=1#security\n\n";
86 exit;
87 }
88 # Even if re-login somehow failed the password rotation
89 # succeeded; send them to the login page rather than
90 # leaving them in a half-state.
91 print "Status: 302 Found\nLocation: /login.cgi?pw_changed=1\n\n";
92 exit;
93 } else {
94 $err = 'Could not save the new password. Please try again.';
95 }
96 }
97 }
98}
99
100my $tvars = {
101 email => _h($userinfo->{email} || ''),
102 err => _h($err),
103 has_err => length($err) ? 1 : 0,
104};
105
106print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n";
107my $body = join('', $tfile->template('webstls_password_change.html', $tvars, $userinfo));
108
109$wrap->render({
110 userinfo => $userinfo,
111 page_key => 'my_profile',
112 title => 'Change password',
113 body => $body,
114});
115exit;
116
117#======================================================================
118# Helpers
119#======================================================================
120
121sub _h {
122 my $s = shift // '';
123 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
124 $s =~ s/"/&quot;/g; $s =~ s/'/&#39;/g;
125 return $s;
126}
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help