Diff -- /var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/Login.pm

O Operator
Diff

/var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/Login.pm

added on local at 2026-06-22 16:19:48

Added
+0
lines
Removed
-0
lines
Context
221
unchanged
Blobs
from 409b87da579d
to 409b87da579d
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
11package MODS::Login;
22#======================================================================
33# Meta-Admin -- session-cookie login. Built minimal because there's
44# exactly one operator (Shawn) and we don't need self-signup, role
55# matrices, or email verification here.
66#
77# Public API:
88# login_verify() -> $userinfo hashref or undef
99# sign_in($email, $pw) -> ($user_id, $session_id) or (0, error)
1010# sign_out($sid) -> void
1111# set_password($uid, $pw)
1212#======================================================================
1313use strict;
1414use warnings;
1515use Digest::SHA qw(sha256_hex);
1616
1717use MODS::DBConnect;
1818use MODS::MetaAdmin::Config;
1919
2020my $cfg = MODS::MetaAdmin::Config->new;
2121
2222sub new { return bless({}, shift); }
2323
2424sub _parse_cookie {
2525 my $name = shift;
2626 my $raw = $ENV{HTTP_COOKIE} || '';
2727 foreach my $pair (split /;\s*/, $raw) {
2828 my ($k, $v) = split /=/, $pair, 2;
2929 next unless defined $k && defined $v;
3030 $k =~ s/^\s+|\s+$//g;
3131 return $v if $k eq $name;
3232 }
3333 return undef;
3434}
3535
3636sub _bcrypt_check {
3737 my ($plain, $hash) = @_;
3838 # Plesk doesn't always ship Crypt::Eksblowfish, so we use a
3939 # SHA-256(salt . pw) scheme for this internal-only operator
4040 # account. Hash format: 'sha256$<hex_salt>$<hex_hash>'. The seed
4141 # row uses '$2a$10$REPLACEMEONFIRSTLOGIN' as a sentinel so the
4242 # first /login.cgi visit prompts a password set.
4343 return 0 if !$hash || !defined $plain;
4444 if ($hash =~ /^\$2a\$10\$REPLACEMEONFIRSTLOGIN$/) {
4545 return 0; # never matches; first-login flow handles set
4646 }
4747 if ($hash =~ /^sha256\$([a-f0-9]+)\$([a-f0-9]+)$/) {
4848 my ($salt, $want) = ($1, $2);
4949 my $got = sha256_hex($salt . $plain);
5050 return ($got eq $want) ? 1 : 0;
5151 }
5252 return 0;
5353}
5454
5555sub _hash_password {
5656 my ($plain) = @_;
5757 my @c = ('0'..'9','a'..'f');
5858 my $salt = join '', map { $c[int rand @c] } 1..32;
5959 return 'sha256$' . $salt . '$' . sha256_hex($salt . $plain);
6060}
6161
6262sub _gen_sid {
6363 my @c = ('a'..'z','A'..'Z',0..9);
6464 return join '', map { $c[int rand @c] } 1..48;
6565}
6666
6767sub login_verify {
6868 my $self = shift;
6969 my $cookie_name = $cfg->settings('cookie_name') || 'meta_session';
7070 my $sid = _parse_cookie($cookie_name);
7171 return undef unless $sid && $sid =~ /^[A-Za-z0-9]{48}$/;
7272
7373 my $db = MODS::DBConnect->new;
7474 my $dbh = $db->db_connect();
7575 return undef unless $dbh;
7676
7777 my $sid_q = $sid; $sid_q =~ s/'/''/g;
7878 my $r = $db->db_readwrite($dbh, qq~
7979 SELECT s.user_id, s.id AS session_id,
8080 u.email, u.display_name, u.is_super_admin,
8181 u.last_active_at, u.session_minutes_override
8282 FROM sessions s
8383 JOIN users u ON u.id = s.user_id
8484 WHERE s.id='$sid_q' AND s.expires_at > NOW()
8585 LIMIT 1
8686 ~, __FILE__, __LINE__);
8787 unless ($r && $r->{user_id}) {
8888 $db->db_disconnect($dbh);
8989 return undef;
9090 }
9191
9292 # === Sliding-session idle check ===
9393 my $_idle = $r->{session_minutes_override} ? int($r->{session_minutes_override}) : int($cfg->settings('session_minutes') || 720);
9494 if ($r->{last_active_at}) {
9595 my $_exp = $db->db_readwrite($dbh, qq~
9696 SELECT (TIMESTAMPDIFF(MINUTE, '$r->{last_active_at}', NOW()) > $_idle) AS expired
9797 ~, __FILE__, __LINE__);
9898 if ($_exp && $_exp->{expired}) {
9999 $db->db_readwrite($dbh, qq~DELETE FROM sessions WHERE id='$sid_q'~, __FILE__, __LINE__);
100100 $db->db_disconnect($dbh);
101101 return undef;
102102 }
103103 }
104104
105105 # === Maintenance lockdown: only super_admins pass when locked ===
106106 if ($cfg->settings('maintenance_locked') && !$r->{is_super_admin}) {
107107 $db->db_readwrite($dbh, qq~DELETE FROM sessions WHERE id='$sid_q'~, __FILE__, __LINE__);
108108 $db->db_disconnect($dbh);
109109 return undef;
110110 }
111111
112112 # === Bump last_active_at ===
113113 my $uid_q = int($r->{user_id});
114114 $db->db_readwrite($dbh, qq~UPDATE users SET last_active_at = NOW() WHERE id = $uid_q~, __FILE__, __LINE__);
115115
116116 $db->db_disconnect($dbh);
117117 return {
118118 user_id => $r->{user_id},
119119 email => $r->{email},
120120 display_name => $r->{display_name},
121121 is_super_admin => $r->{is_super_admin},
122122 };
123123}
124124
125125# returns ($user_id, $session_id) on success; (0, $error_msg) on fail.
126126sub sign_in {
127127 my ($self, $email, $pw) = @_;
128128 return (0, 'email and password required') unless $email && defined $pw;
129129
130130 my $db = MODS::DBConnect->new;
131131 my $dbh = $db->db_connect();
132132 return (0, 'db unavailable') unless $dbh;
133133
134134 my $em_q = lc $email; $em_q =~ s/'/''/g;
135135 my $r = $db->db_readwrite($dbh, qq~
136136 SELECT id, password_hash FROM users WHERE LOWER(email)='$em_q' LIMIT 1
137137 ~, __FILE__, __LINE__);
138138 unless ($r && $r->{id}) {
139139 $db->db_disconnect($dbh);
140140 return (0, 'no such operator');
141141 }
142142 unless (_bcrypt_check($pw, $r->{password_hash})) {
143143 $db->db_disconnect($dbh);
144144 # Sentinel hash means "first-login" -- caller routes to set-password.
145145 return (0, ($r->{password_hash} =~ /REPLACEMEONFIRSTLOGIN/)
146146 ? 'first_login_required'
147147 : 'wrong password');
148148 }
149149 my $uid = $r->{id};
150150
151151 # Maintenance lockdown: only super_admins can sign in when locked.
152152 if ($cfg->settings('maintenance_locked')) {
153153 my $isadm = $db->db_readwrite($dbh, qq~SELECT is_super_admin FROM users WHERE id='$uid' LIMIT 1~, __FILE__, __LINE__);
154154 unless ($isadm && $isadm->{is_super_admin}) {
155155 $db->db_disconnect($dbh);
156156 return (0, 'maintenance_locked');
157157 }
158158 }
159159
160160 my $sid = _gen_sid();
161161 # 10-year safety-net expiry; real expiry is sliding via users.last_active_at.
162162 my $minutes = 5256000;
163163 my $ip = $ENV{REMOTE_ADDR} || ''; $ip =~ s/'/''/g;
164164 my $ua = $ENV{HTTP_USER_AGENT} || ''; $ua =~ s/'/''/g; $ua = substr($ua,0,250);
165165 $db->db_readwrite($dbh, qq~
166166 INSERT INTO sessions (id, user_id, expires_at, ip_addr, user_agent)
167167 VALUES ('$sid', '$uid', DATE_ADD(NOW(), INTERVAL $minutes MINUTE), '$ip', '$ua')
168168 ~, __FILE__, __LINE__);
169169 $db->db_readwrite($dbh, qq~
170170 UPDATE users SET last_login_at=NOW(), last_active_at=NOW() WHERE id='$uid'
171171 ~, __FILE__, __LINE__);
172172 $db->db_disconnect($dbh);
173173 return ($uid, $sid);
174174}
175175
176176sub sign_out {
177177 my ($self, $sid) = @_;
178178 return unless $sid;
179179 my $db = MODS::DBConnect->new;
180180 my $dbh = $db->db_connect();
181181 return unless $dbh;
182182 my $sid_q = $sid; $sid_q =~ s/'/''/g;
183183 $db->db_readwrite($dbh, qq~DELETE FROM sessions WHERE id='$sid_q'~, __FILE__, __LINE__);
184184 $db->db_disconnect($dbh);
185185}
186186
187187sub set_password {
188188 my ($self, $uid, $pw) = @_;
189189 $uid =~ s/[^0-9]//g if defined $uid;
190190 return 0 unless $uid && defined $pw && length($pw) >= 8;
191191 my $db = MODS::DBConnect->new;
192192 my $dbh = $db->db_connect();
193193 return 0 unless $dbh;
194194 my $h = _hash_password($pw); $h =~ s/'/''/g;
195195 $db->db_readwrite($dbh, qq~
196196 UPDATE users SET password_hash='$h' WHERE id='$uid'
197197 ~, __FILE__, __LINE__);
198198 $db->db_disconnect($dbh);
199199 return 1;
200200}
201201
202202# cookie header helper used by login.cgi.
203203sub cookie_header {
204204 my ($self, $sid) = @_;
205205 my $name = $cfg->settings('cookie_name') || 'meta_session';
206206 # Persistent cookie -- server is sole authority via users.last_active_at.
207207 # Cookie lives 10 years; sliding session controls real expiry.
208208 my $minutes = 5256000;
209209 my $domain = $cfg->settings('cookie_domain') || '';
210210 my $secure = $cfg->settings('secure_cookies') ? '; Secure' : '';
211211 my $dom = length($domain) ? "; Domain=$domain" : '';
212212 return "Set-Cookie: $name=$sid; Path=/; Max-Age=" . ($minutes * 60) . "$dom$secure; HttpOnly; SameSite=Lax";
213213}
214214
215215sub clear_cookie_header {
216216 my $self = shift;
217217 my $name = $cfg->settings('cookie_name') || 'meta_session';
218218 return "Set-Cookie: $name=; Path=/; Max-Age=0; HttpOnly";
219219}
220220
2212211;