added on local at 2026-07-02 15:46:11
| 1 | package MODS::Login; | |
| 2 | #====================================================================== | |
| 3 | # TaskForge -- login / sessions / signup / impersonation | |
| 4 | # | |
| 5 | # Cookie-based auth backed by the `users` and `user_sessions` tables. | |
| 6 | # On login we mint a UUID, drop a row in user_sessions, set | |
| 7 | # taskforge_session=<uuid> on the response. | |
| 8 | # On every page load we look up the cookie and return $userinfo joined | |
| 9 | # from users + the active session row + the user's company. | |
| 10 | # | |
| 11 | # Super-admin impersonation: when an is_super_admin user has an active | |
| 12 | # row in admin_impersonation for their session, login_verify() swaps | |
| 13 | # the returned userinfo for the target user (preserving the admin's | |
| 14 | # identity in _admin_* keys so the wrapper can show the banner). | |
| 15 | # | |
| 16 | # Password hashing strategy (best available wins): | |
| 17 | # 1. Crypt::Argon2 (industry best) | |
| 18 | # 2. Salted iterated SHA-256 (100k rounds, works on every Perl) | |
| 19 | #====================================================================== | |
| 20 | ||
| 21 | use strict; | |
| 22 | use warnings; | |
| 23 | ||
| 24 | use MODS::DBConnect; | |
| 25 | use MODS::PTMatrix::Config; | |
| 26 | ||
| 27 | my $HAS_ARGON2 = eval { require Crypt::Argon2; 1 }; | |
| 28 | my $HAS_UUID = eval { require Data::UUID; 1 }; | |
| 29 | my $HAS_DIGEST = eval { require Digest::SHA; 1 }; | |
| 30 | ||
| 31 | my $db = MODS::DBConnect->new; | |
| 32 | my $config = MODS::PTMatrix::Config->new; | |
| 33 | my $DB = $config->settings('database_name'); | |
| 34 | ||
| 35 | our $CURRENT_USER_TZ; | |
| 36 | ||
| 37 | sub new { | |
| 38 | my ($class) = @_; | |
| 39 | return bless({}, $class); | |
| 40 | } | |
| 41 | ||
| 42 | #---------------------------------------------------------------------- | |
| 43 | # login_verify() -- call at the top of every authenticated .cgi. | |
| 44 | # Reads the session cookie, looks the user up, returns: | |
| 45 | # undef -- not logged in (caller should redirect to login) | |
| 46 | # $userinfo -- hashref with user + session + company columns | |
| 47 | #---------------------------------------------------------------------- | |
| 48 | sub login_verify { | |
| 49 | my ($self) = @_; | |
| 50 | ||
| 51 | my $cookie_name = $config->settings('cookie_name'); | |
| 52 | my $token = _read_cookie($cookie_name); | |
| 53 | return undef unless $token && length($token) >= 16; | |
| 54 | return undef if $token =~ /[^a-zA-Z0-9\-]/; | |
| 55 | ||
| 56 | my $dbh = $db->db_connect(); | |
| 57 | return undef unless $dbh; | |
| 58 | ||
| 59 | my $sql = qq~ | |
| 60 | SELECT | |
| 61 | u.id AS user_id, | |
| 62 | u.id AS id, | |
| 63 | u.company_id, | |
| 64 | u.email, | |
| 65 | u.display_name, | |
| 66 | u.job_title, | |
| 67 | u.role, | |
| 68 | u.is_super_admin, | |
| 69 | u.avatar_color, | |
| 70 | u.avatar_storage_key, | |
| 71 | u.timezone, | |
| 72 | u.last_active_at, | |
| 73 | u.session_minutes_override, | |
| 74 | u.account_state, | |
| 75 | u.locale, | |
| 76 | u.two_factor_enabled, | |
| 77 | u.account_status, | |
| 78 | s.id AS session_id, | |
| 79 | s.expires_at, | |
| 80 | s.revoked_at, | |
| 81 | s.two_factor_pending, | |
| 82 | c.name AS company_name, | |
| 83 | c.slug AS company_slug, | |
| 84 | c.brand_color AS company_brand_color, | |
| 85 | c.plan_tier AS company_plan_tier, | |
| 86 | c.trial_ends_at AS company_trial_ends_at, | |
| 87 | c.status AS company_status, | |
| 88 | c.logo_storage_key AS company_logo_storage_key | |
| 89 | FROM ${DB}.users u | |
| 90 | JOIN ${DB}.user_sessions s ON s.user_id = u.id | |
| 91 | LEFT JOIN ${DB}.companies c ON c.id = u.company_id | |
| 92 | WHERE s.id = '$token' | |
| 93 | AND s.revoked_at IS NULL | |
| 94 | AND s.expires_at > NOW() | |
| 95 | AND s.two_factor_pending = 0 | |
| 96 | AND u.account_status = 'active' | |
| 97 | LIMIT 1 | |
| 98 | ~; | |
| 99 | my $row = $db->db_readwrite($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__); | |
| 100 | ||
| 101 | if (!$row || !$row->{user_id}) { | |
| 102 | $db->db_disconnect($dbh); | |
| 103 | return undef; | |
| 104 | } | |
| 105 | ||
| 106 | # Super-admin impersonation. If the user has is_super_admin = 1 AND | |
| 107 | # has an active row in admin_impersonation tied to their session, | |
| 108 | # swap the returned userinfo to the target user. Admin identity is | |
| 109 | # preserved in _admin_* keys so the banner + Stop-impersonating | |
| 110 | # button keep working. | |
| 111 | if ($row->{is_super_admin}) { | |
| 112 | my $sid = $row->{session_id}; | |
| 113 | $sid =~ s/[^a-zA-Z0-9\-]//g; | |
| 114 | my $imp = $db->db_readwrite($dbh, qq~ | |
| 115 | SELECT i.target_user_id, i.mode, | |
| 116 | t.id AS t_user_id, | |
| 117 | t.company_id AS t_company_id, | |
| 118 | t.email AS t_email, | |
| 119 | t.display_name AS t_display_name, | |
| 120 | t.job_title AS t_job_title, | |
| 121 | t.role AS t_role, | |
| 122 | t.avatar_color AS t_avatar_color, | |
| 123 | t.account_status AS t_account_status, | |
| 124 | t.timezone AS t_timezone, | |
| 125 | t.locale AS t_locale, | |
| 126 | c.name AS t_company_name, | |
| 127 | c.slug AS t_company_slug, | |
| 128 | c.brand_color AS t_company_brand_color, | |
| 129 | c.plan_tier AS t_company_plan_tier | |
| 130 | FROM ${DB}.admin_impersonation i | |
| 131 | JOIN ${DB}.users t ON t.id = i.target_user_id | |
| 132 | LEFT JOIN ${DB}.companies c ON c.id = t.company_id | |
| 133 | WHERE i.session_id = '$sid' | |
| 134 | LIMIT 1 | |
| 135 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 136 | ||
| 137 | if ($imp && $imp->{target_user_id}) { | |
| 138 | $row->{_admin_user_id} = $row->{user_id}; | |
| 139 | $row->{_admin_email} = $row->{email}; | |
| 140 | $row->{_admin_display_name} = $row->{display_name}; | |
| 141 | $row->{_admin_is_super_admin}= 1; | |
| 142 | $row->{_admin_mode} = $imp->{mode} || 'control'; | |
| 143 | $row->{_impersonating} = 1; | |
| 144 | ||
| 145 | $row->{user_id} = $imp->{t_user_id}; | |
| 146 | $row->{id} = $imp->{t_user_id}; | |
| 147 | $row->{company_id} = $imp->{t_company_id}; | |
| 148 | $row->{email} = $imp->{t_email}; | |
| 149 | $row->{display_name} = $imp->{t_display_name}; | |
| 150 | $row->{job_title} = $imp->{t_job_title}; | |
| 151 | $row->{role} = $imp->{t_role}; | |
| 152 | $row->{avatar_color} = $imp->{t_avatar_color}; | |
| 153 | $row->{timezone} = $imp->{t_timezone}; | |
| 154 | $row->{locale} = $imp->{t_locale}; | |
| 155 | $row->{account_status} = $imp->{t_account_status}; | |
| 156 | $row->{company_name} = $imp->{t_company_name}; | |
| 157 | $row->{company_slug} = $imp->{t_company_slug}; | |
| 158 | $row->{company_brand_color} = $imp->{t_company_brand_color}; | |
| 159 | $row->{company_plan_tier} = $imp->{t_company_plan_tier}; | |
| 160 | $row->{is_super_admin} = 0; | |
| 161 | } | |
| 162 | } | |
| 163 | ||
| 164 | # === Sliding-session idle check + maintenance lockdown === | |
| 165 | # Real session expiry is computed here, not at session-mint time. | |
| 166 | # Idle timeout = settings('session_minutes') (or per-user override). | |
| 167 | my $_idle = $row->{session_minutes_override} ? int($row->{session_minutes_override}) : int($config->settings('session_minutes') || 720); | |
| 168 | if ($row->{last_active_at}) { | |
| 169 | my $_exp = $db->db_readwrite($dbh, qq{ | |
| 170 | SELECT (TIMESTAMPDIFF(MINUTE, '$row->{last_active_at}', NOW()) > $_idle) AS expired | |
| 171 | }, $ENV{SCRIPT_NAME}, __LINE__); | |
| 172 | if ($_exp && $_exp->{expired}) { | |
| 173 | my $_sid = $row->{session_id}; $_sid =~ s/[^a-zA-Z0-9\-]//g; | |
| 174 | $db->db_readwrite($dbh, qq{DELETE FROM ${DB}.user_sessions WHERE id='$_sid'}, $ENV{SCRIPT_NAME}, __LINE__); | |
| 175 | $db->db_disconnect($dbh); | |
| 176 | return undef; | |
| 177 | } | |
| 178 | } | |
| 179 | # Maintenance lockdown: only super_admins pass when locked. | |
| 180 | if ($config->settings('maintenance_locked') && !$row->{is_super_admin} && !$row->{_admin_is_super_admin}) { | |
| 181 | my $_sid = $row->{session_id}; $_sid =~ s/[^a-zA-Z0-9\-]//g; | |
| 182 | $db->db_readwrite($dbh, qq{DELETE FROM ${DB}.user_sessions WHERE id='$_sid'}, $ENV{SCRIPT_NAME}, __LINE__); | |
| 183 | $db->db_disconnect($dbh); | |
| 184 | return undef; | |
| 185 | } | |
| 186 | # Account state guard: cancelled / banned / billing_locked users | |
| 187 | # get their session killed here mid-flow. Admins impersonating a | |
| 188 | # locked user still see the account (for support / audit). | |
| 189 | if ($row->{account_state} && $row->{account_state} ne 'active' && !$row->{_admin_is_super_admin}) { | |
| 190 | my $_sid = $row->{session_id}; $_sid =~ s/[^a-zA-Z0-9\-]//g; | |
| 191 | $db->db_readwrite($dbh, qq{DELETE FROM ${DB}.user_sessions WHERE id='$_sid'}, $ENV{SCRIPT_NAME}, __LINE__); | |
| 192 | $db->db_disconnect($dbh); | |
| 193 | return undef; | |
| 194 | } | |
| 195 | # Bump last_active_at for the REAL user (preserves through impersonation) | |
| 196 | my $_real_uid = $row->{_admin_user_id} || $row->{id}; | |
| 197 | $_real_uid =~ s/[^0-9]//g; | |
| 198 | $db->db_readwrite($dbh, qq{UPDATE ${DB}.users SET last_active_at = NOW() WHERE id = $_real_uid}, $ENV{SCRIPT_NAME}, __LINE__); | |
| 199 | ||
| 200 | # Phase-3 auto-add IP to tracking_exclusions if the toggle is on. | |
| 201 | _phase3_autoadd_tracking_ip($db, $dbh, $DB, $config, $row); | |
| 202 | ||
| 203 | $db->db_disconnect($dbh); | |
| 204 | ||
| 205 | $CURRENT_USER_TZ = $row->{timezone} || 'UTC'; | |
| 206 | return $row; | |
| 207 | } | |
| 208 | ||
| 209 | #---------------------------------------------------------------------- | |
| 210 | # login_exec($email, $password) -- verify creds, mint session. | |
| 211 | # Returns ($userinfo, $session_token, $needs_2fa) on success, () on failure. | |
| 212 | #---------------------------------------------------------------------- | |
| 213 | sub login_exec { | |
| 214 | my ($self, $email, $password) = @_; | |
| 215 | return () unless $email && $password; | |
| 216 | ||
| 217 | my $dbh = $db->db_connect(); | |
| 218 | return () unless $dbh; | |
| 219 | ||
| 220 | my $safe_email = $email; | |
| 221 | $safe_email =~ s/[\\']/\\$&/g; | |
| 222 | ||
| 223 | my $user = $db->db_readwrite($dbh, qq~ | |
| 224 | SELECT id, email, password_hash, account_status, account_state, two_factor_enabled, company_id | |
| 225 | FROM ${DB}.users | |
| 226 | WHERE email = '$safe_email' | |
| 227 | LIMIT 1 | |
| 228 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 229 | ||
| 230 | if (!$user || !$user->{id} || $user->{account_status} ne 'active') { | |
| 231 | $db->db_disconnect($dbh); | |
| 232 | return (); | |
| 233 | } | |
| 234 | if ($user->{account_state} && $user->{account_state} ne 'active') { | |
| 235 | $db->db_disconnect($dbh); | |
| 236 | return (); | |
| 237 | } | |
| 238 | if (_phase3_is_blocked($db, $dbh, $DB, $ENV{REMOTE_ADDR}, $email)) { | |
| 239 | $db->db_disconnect($dbh); | |
| 240 | return (); | |
| 241 | } | |
| 242 | ||
| 243 | if (!_verify_password($password, $user->{password_hash})) { | |
| 244 | $db->db_disconnect($dbh); | |
| 245 | return (); | |
| 246 | } | |
| 247 | ||
| 248 | # expires_at is a 10-year safety net only -- real expiry is sliding via users.last_active_at | |
| 249 | my $token = _new_uuid(); | |
| 250 | my $minutes = 5256000; # ~10 years | |
| 251 | my $ua = ($ENV{HTTP_USER_AGENT} || ''); | |
| 252 | $ua =~ s/[\\']/\\$&/g; | |
| 253 | $ua = substr($ua, 0, 255); | |
| 254 | my $ip = ($ENV{REMOTE_ADDR} || ''); | |
| 255 | $ip =~ s/[^0-9a-fA-F.:]//g; | |
| 256 | $ip = substr($ip, 0, 45); | |
| 257 | ||
| 258 | my $needs_2fa = $user->{two_factor_enabled} ? 1 : 0; | |
| 259 | ||
| 260 | $db->db_readwrite($dbh, qq~ | |
| 261 | INSERT INTO ${DB}.user_sessions SET | |
| 262 | id = '$token', | |
| 263 | user_id = '$user->{id}', | |
| 264 | ip_addr = '$ip', | |
| 265 | user_agent = '$ua', | |
| 266 | issued_at = NOW(), | |
| 267 | expires_at = DATE_ADD(NOW(), INTERVAL $minutes MINUTE), | |
| 268 | two_factor_pending = '$needs_2fa' | |
| 269 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 270 | ||
| 271 | $db->db_readwrite($dbh, qq~ | |
| 272 | UPDATE ${DB}.users SET last_login_at = NOW(), last_active_at = NOW() WHERE id = '$user->{id}' | |
| 273 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 274 | ||
| 275 | my $userinfo = $db->db_readwrite($dbh, qq~ | |
| 276 | SELECT * FROM ${DB}.users WHERE id = '$user->{id}' | |
| 277 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 278 | $userinfo->{user_id} = $userinfo->{id}; | |
| 279 | $userinfo->{session_id} = $token; | |
| 280 | ||
| 281 | $db->db_disconnect($dbh); | |
| 282 | ||
| 283 | return ($userinfo, $token, $needs_2fa); | |
| 284 | } | |
| 285 | ||
| 286 | #---------------------------------------------------------------------- | |
| 287 | # signup_company($company_name, $email, $password, $display_name) | |
| 288 | # -- creates a Company + first user (company_admin role). | |
| 289 | # Returns ($user_id, $company_id) on success, () on dup-email/failure. | |
| 290 | #---------------------------------------------------------------------- | |
| 291 | sub signup_company { | |
| 292 | my ($self, $company_name, $email, $password, $display_name, $plan) = @_; | |
| 293 | return () unless $company_name && $email && $password && length($password) >= 8; | |
| 294 | $plan = '' unless defined $plan; | |
| 295 | $plan = '' unless $plan =~ /^(free|starter|pro|business|enterprise)$/; | |
| 296 | ||
| 297 | $display_name ||= (split /\@/, $email)[0]; | |
| 298 | ||
| 299 | my $hash = _hash_password($password); | |
| 300 | return () unless $hash; | |
| 301 | ||
| 302 | my $dbh = $db->db_connect(); | |
| 303 | return () unless $dbh; | |
| 304 | ||
| 305 | # --- phase4-signup-blocklist :: 2026-07-02 --- | |
| 306 | if (_phase3_is_blocked($db, $dbh, $DB, $ENV{REMOTE_ADDR}, $email)) { | |
| 307 | $db->db_disconnect($dbh); | |
| 308 | return (); | |
| 309 | } | |
| 310 | ||
| 311 | # Email must be unique platform-wide. | |
| 312 | my $safe_email = $email; | |
| 313 | $safe_email =~ s/[\\']/\\$&/g; | |
| 314 | my $existing = $db->db_readwrite($dbh, qq~ | |
| 315 | SELECT id FROM ${DB}.users WHERE email='$safe_email' LIMIT 1 | |
| 316 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 317 | if ($existing && $existing->{id}) { | |
| 318 | $db->db_disconnect($dbh); | |
| 319 | return (); | |
| 320 | } | |
| 321 | ||
| 322 | my $slug = _slugify($company_name); | |
| 323 | # Ensure unique slug | |
| 324 | my $base_slug = $slug; | |
| 325 | my $n = 1; | |
| 326 | while (1) { | |
| 327 | my $r = $db->db_readwrite($dbh, qq~ | |
| 328 | SELECT id FROM ${DB}.companies WHERE slug='$slug' LIMIT 1 | |
| 329 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 330 | last unless $r && $r->{id}; | |
| 331 | $n++; | |
| 332 | $slug = "$base_slug-$n"; | |
| 333 | } | |
| 334 | ||
| 335 | my $safe_company = $company_name; | |
| 336 | $safe_company =~ s/[\\']/\\$&/g; | |
| 337 | ||
| 338 | # Default: 14-day trial (everything unlocked). If plan=free was explicitly | |
| 339 | # chosen, create at plan_tier='free' (no expiry, seat-capped, feature-gated). | |
| 340 | my ($plan_tier_sql, $trial_sql); | |
| 341 | if ($plan eq 'free') { | |
| 342 | $plan_tier_sql = "'free'"; | |
| 343 | $trial_sql = 'NULL'; | |
| 344 | } else { | |
| 345 | $plan_tier_sql = "'trial'"; | |
| 346 | $trial_sql = 'DATE_ADD(NOW(), INTERVAL 14 DAY)'; | |
| 347 | } | |
| 348 | my $c_id = $db->db_readwrite($dbh, qq~ | |
| 349 | INSERT INTO ${DB}.companies SET | |
| 350 | slug = '$slug', | |
| 351 | name = '$safe_company', | |
| 352 | plan_tier = $plan_tier_sql, | |
| 353 | trial_ends_at = $trial_sql, | |
| 354 | status = 'active', | |
| 355 | seat_count = 1, | |
| 356 | created_at = NOW() | |
| 357 | ~, $ENV{SCRIPT_NAME}, __LINE__)->{mysql_insertid}; | |
| 358 | ||
| 359 | unless ($c_id) { | |
| 360 | $db->db_disconnect($dbh); | |
| 361 | return (); | |
| 362 | } | |
| 363 | ||
| 364 | my $safe_name = $display_name; | |
| 365 | $safe_name =~ s/[\\']/\\$&/g; | |
| 366 | my $safe_hash = $hash; | |
| 367 | $safe_hash =~ s/[\\']/\\$&/g; | |
| 368 | ||
| 369 | my $u_id = $db->db_readwrite($dbh, qq~ | |
| 370 | INSERT INTO ${DB}.users SET | |
| 371 | company_id = '$c_id', | |
| 372 | email = '$safe_email', | |
| 373 | password_hash = '$safe_hash', | |
| 374 | display_name = '$safe_name', | |
| 375 | role = 'company_admin', | |
| 376 | account_status = 'active', | |
| 377 | created_at = NOW(), | |
| 378 | email_verified_at = NOW() | |
| 379 | ~, $ENV{SCRIPT_NAME}, __LINE__)->{mysql_insertid}; | |
| 380 | ||
| 381 | # Seed default user_settings row. | |
| 382 | $db->db_readwrite($dbh, qq~ | |
| 383 | INSERT INTO ${DB}.user_settings (user_id) VALUES ('$u_id') | |
| 384 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 385 | ||
| 386 | # Seed default task types for the new company. | |
| 387 | my @TYPES = ( | |
| 388 | ['Task', 'task', '#5aa9ff', 1, 1], | |
| 389 | ['Bug', 'bug', '#ff6b6b', 0, 2], | |
| 390 | ['Feature', 'feature', '#8b5cf6', 0, 3], | |
| 391 | ['Chore', 'chore', '#94a3b8', 0, 4], | |
| 392 | ['Epic', 'epic', '#f59e0b', 0, 5], | |
| 393 | ); | |
| 394 | foreach my $t (@TYPES) { | |
| 395 | my ($name, $tslug, $color, $is_default, $pos) = @$t; | |
| 396 | $db->db_readwrite($dbh, qq~ | |
| 397 | INSERT INTO ${DB}.task_types | |
| 398 | (company_id, name, slug, color, is_default, position) | |
| 399 | VALUES | |
| 400 | ('$c_id', '$name', '$tslug', '$color', '$is_default', '$pos') | |
| 401 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 402 | } | |
| 403 | ||
| 404 | $db->db_disconnect($dbh); | |
| 405 | ||
| 406 | return ($u_id, $c_id); | |
| 407 | } | |
| 408 | ||
| 409 | #---------------------------------------------------------------------- | |
| 410 | # invite_user($company_id, $email, $display_name, $role, $invited_by_user_id) | |
| 411 | # -- create a pending user with an invite token; returns ($user_id, $token). | |
| 412 | #---------------------------------------------------------------------- | |
| 413 | sub invite_user { | |
| 414 | my ($self, $company_id, $email, $display_name, $role, $invited_by) = @_; | |
| 415 | return () unless $company_id && $email; | |
| 416 | $role ||= 'member'; | |
| 417 | $display_name ||= (split /\@/, $email)[0]; | |
| 418 | ||
| 419 | my $dbh = $db->db_connect(); | |
| 420 | return () unless $dbh; | |
| 421 | ||
| 422 | my $safe_email = $email; | |
| 423 | $safe_email =~ s/[\\']/\\$&/g; | |
| 424 | my $existing = $db->db_readwrite($dbh, qq~ | |
| 425 | SELECT id FROM ${DB}.users WHERE email='$safe_email' LIMIT 1 | |
| 426 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 427 | if ($existing && $existing->{id}) { | |
| 428 | $db->db_disconnect($dbh); | |
| 429 | return (); | |
| 430 | } | |
| 431 | ||
| 432 | my $token = _gen_token(48); | |
| 433 | my $safe_name = $display_name; | |
| 434 | $safe_name =~ s/[\\']/\\$&/g; | |
| 435 | $company_id += 0; | |
| 436 | $invited_by += 0; | |
| 437 | ||
| 438 | my $u_id = $db->db_readwrite($dbh, qq~ | |
| 439 | INSERT INTO ${DB}.users SET | |
| 440 | company_id = '$company_id', | |
| 441 | email = '$safe_email', | |
| 442 | password_hash = '!INVITED!', | |
| 443 | display_name = '$safe_name', | |
| 444 | role = '$role', | |
| 445 | account_status = 'pending_verification', | |
| 446 | invited_by_user_id = '$invited_by', | |
| 447 | invite_token = '$token', | |
| 448 | invite_expires_at = DATE_ADD(NOW(), INTERVAL 14 DAY), | |
| 449 | created_at = NOW() | |
| 450 | ~, $ENV{SCRIPT_NAME}, __LINE__)->{mysql_insertid}; | |
| 451 | ||
| 452 | $db->db_disconnect($dbh); | |
| 453 | return ($u_id, $token); | |
| 454 | } | |
| 455 | ||
| 456 | #---------------------------------------------------------------------- | |
| 457 | # accept_invite($token, $password) -- consume an invite token, set | |
| 458 | # password, activate the account. Returns ($userinfo, $session_token). | |
| 459 | #---------------------------------------------------------------------- | |
| 460 | sub accept_invite { | |
| 461 | my ($self, $token, $password) = @_; | |
| 462 | return () unless $token && $password && length($password) >= 8; | |
| 463 | $token =~ s/[^A-Za-z0-9_\-]//g; | |
| 464 | return () unless length($token) >= 32; | |
| 465 | ||
| 466 | my $hash = _hash_password($password); | |
| 467 | return () unless $hash; | |
| 468 | ||
| 469 | my $dbh = $db->db_connect(); | |
| 470 | return () unless $dbh; | |
| 471 | ||
| 472 | my $u = $db->db_readwrite($dbh, qq~ | |
| 473 | SELECT id, email FROM ${DB}.users | |
| 474 | WHERE invite_token='$token' | |
| 475 | AND invite_expires_at > NOW() | |
| 476 | AND account_status='pending_verification' | |
| 477 | LIMIT 1 | |
| 478 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 479 | ||
| 480 | unless ($u && $u->{id}) { | |
| 481 | $db->db_disconnect($dbh); | |
| 482 | return (); | |
| 483 | } | |
| 484 | ||
| 485 | my $safe_hash = $hash; | |
| 486 | $safe_hash =~ s/[\\']/\\$&/g; | |
| 487 | $db->db_readwrite($dbh, qq~ | |
| 488 | UPDATE ${DB}.users | |
| 489 | SET password_hash='$safe_hash', | |
| 490 | account_status='active', | |
| 491 | email_verified_at=NOW(), | |
| 492 | invite_token=NULL, | |
| 493 | invite_expires_at=NULL | |
| 494 | WHERE id='$u->{id}' | |
| 495 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 496 | ||
| 497 | # Seed user_settings row | |
| 498 | $db->db_readwrite($dbh, qq~ | |
| 499 | INSERT IGNORE INTO ${DB}.user_settings (user_id) VALUES ('$u->{id}') | |
| 500 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 501 | ||
| 502 | $db->db_disconnect($dbh); | |
| 503 | ||
| 504 | return $self->login_exec($u->{email}, $password); | |
| 505 | } | |
| 506 | ||
| 507 | #---------------------------------------------------------------------- | |
| 508 | # update_password($user_id, $new_plain) -- replace a user's password | |
| 509 | # hash. Revokes all active sessions for the user. | |
| 510 | #---------------------------------------------------------------------- | |
| 511 | sub update_password { | |
| 512 | my ($self, $user_id, $new_plain) = @_; | |
| 513 | $user_id =~ s/[^0-9]//g if defined $user_id; | |
| 514 | return 0 unless $user_id; | |
| 515 | return 0 unless defined $new_plain && length($new_plain) >= 8; | |
| 516 | ||
| 517 | my $hash = _hash_password($new_plain); | |
| 518 | return 0 unless $hash; | |
| 519 | $hash =~ s/[\\']/\\$&/g; | |
| 520 | ||
| 521 | my $dbh = $db->db_connect(); | |
| 522 | return 0 unless $dbh; | |
| 523 | ||
| 524 | $db->db_readwrite($dbh, qq~ | |
| 525 | UPDATE ${DB}.users SET password_hash='$hash' WHERE id='$user_id' | |
| 526 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 527 | ||
| 528 | $db->db_readwrite($dbh, qq~ | |
| 529 | UPDATE ${DB}.user_sessions | |
| 530 | SET revoked_at=NOW() | |
| 531 | WHERE user_id='$user_id' AND revoked_at IS NULL | |
| 532 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 533 | ||
| 534 | $db->db_disconnect($dbh); | |
| 535 | return 1; | |
| 536 | } | |
| 537 | ||
| 538 | #---------------------------------------------------------------------- | |
| 539 | # logout_exec($userinfo_or_token) -- revoke the session. | |
| 540 | #---------------------------------------------------------------------- | |
| 541 | sub logout_exec { | |
| 542 | my ($self, $userinfo) = @_; | |
| 543 | my $token = ref($userinfo) ? $userinfo->{session_id} : $userinfo; | |
| 544 | return unless $token; | |
| 545 | return if $token =~ /[^a-zA-Z0-9\-]/; | |
| 546 | ||
| 547 | my $dbh = $db->db_connect(); | |
| 548 | return unless $dbh; | |
| 549 | $db->db_readwrite($dbh, qq~ | |
| 550 | UPDATE ${DB}.user_sessions SET revoked_at = NOW() WHERE id = '$token' | |
| 551 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 552 | $db->db_disconnect($dbh); | |
| 553 | return 1; | |
| 554 | } | |
| 555 | ||
| 556 | #---------------------------------------------------------------------- | |
| 557 | # Cookie header helpers. | |
| 558 | #---------------------------------------------------------------------- | |
| 559 | sub set_cookie_header { | |
| 560 | my ($self, $token) = @_; | |
| 561 | my $name = $config->settings('cookie_name'); | |
| 562 | my $minutes = 5256000; # 10y; server controls real expiry | |
| 563 | # session_minutes_override: lift cookie Max-Age to match the server-side | |
| 564 | # expires_at when the owning user has a per-account override. | |
| 565 | if ($token) { | |
| 566 | my $cdbh = $db->db_connect(); | |
| 567 | if ($cdbh) { | |
| 568 | my $tk = $token; $tk =~ s/'/''/g; | |
| 569 | my $ovr = $db->db_readwrite($cdbh, qq~ | |
| 570 | SELECT u.session_minutes_override | |
| 571 | FROM ${DB}.user_sessions s | |
| 572 | JOIN ${DB}.users u ON u.id = s.user_id | |
| 573 | WHERE s.id = '$tk' LIMIT 1 | |
| 574 | ~, __FILE__, __LINE__); | |
| 575 | if ($ovr && $ovr->{session_minutes_override}) { | |
| 576 | $minutes = int($ovr->{session_minutes_override}); | |
| 577 | } | |
| 578 | $db->db_disconnect($cdbh); | |
| 579 | } | |
| 580 | } | |
| 581 | my $secure = $config->settings('secure_cookies') ? '; Secure' : ''; | |
| 582 | my $dom_v = $config->settings('cookie_domain') || ''; | |
| 583 | my $domain = length($dom_v) ? "; Domain=$dom_v" : ''; | |
| 584 | return "Set-Cookie: $name=$token; Path=/$domain; Max-Age=" . ($minutes * 60) . | |
| 585 | "; HttpOnly; SameSite=Lax$secure\n"; | |
| 586 | } | |
| 587 | ||
| 588 | sub clear_cookie_header { | |
| 589 | my ($self) = @_; | |
| 590 | my $name = $config->settings('cookie_name'); | |
| 591 | my $dom_v = $config->settings('cookie_domain') || ''; | |
| 592 | my $domain = length($dom_v) ? "; Domain=$dom_v" : ''; | |
| 593 | return "Set-Cookie: $name=; Path=/$domain; Max-Age=0; HttpOnly; SameSite=Lax\n"; | |
| 594 | } | |
| 595 | ||
| 596 | #====================================================================== | |
| 597 | # Internal helpers | |
| 598 | #====================================================================== | |
| 599 | ||
| 600 | sub _read_cookie { | |
| 601 | my ($name) = @_; | |
| 602 | my $raw = $ENV{HTTP_COOKIE} || ''; | |
| 603 | foreach my $piece (split /;\s*/, $raw) { | |
| 604 | my ($k, $v) = split /=/, $piece, 2; | |
| 605 | return $v if defined $k && $k eq $name; | |
| 606 | } | |
| 607 | return undef; | |
| 608 | } | |
| 609 | ||
| 610 | sub _new_uuid { | |
| 611 | if ($HAS_UUID) { | |
| 612 | return lc(Data::UUID->new->create_str); | |
| 613 | } | |
| 614 | my @hex = ('0'..'9','a'..'f'); | |
| 615 | my $rand = sub { join('', map { $hex[int(rand 16)] } 1..$_[0]) }; | |
| 616 | return $rand->(8) . '-' . $rand->(4) . '-4' . $rand->(3) . '-' . | |
| 617 | ((qw(8 9 a b))[int(rand 4)]) . $rand->(3) . '-' . $rand->(12); | |
| 618 | } | |
| 619 | ||
| 620 | sub _gen_token { | |
| 621 | my ($len) = @_; | |
| 622 | $len ||= 32; | |
| 623 | my @c = ('a'..'z','A'..'Z','0'..'9'); | |
| 624 | my $t = ''; | |
| 625 | $t .= $c[int(rand 62)] for 1..$len; | |
| 626 | return $t; | |
| 627 | } | |
| 628 | ||
| 629 | sub _slugify { | |
| 630 | my ($s) = @_; | |
| 631 | $s = lc($s); | |
| 632 | $s =~ s/[^a-z0-9]+/-/g; | |
| 633 | $s =~ s/^-+|-+$//g; | |
| 634 | $s = substr($s, 0, 60); | |
| 635 | $s ||= 'company'; | |
| 636 | return $s; | |
| 637 | } | |
| 638 | ||
| 639 | sub _hash_password { | |
| 640 | my ($plain) = @_; | |
| 641 | return undef unless defined $plain && length $plain; | |
| 642 | ||
| 643 | if ($HAS_ARGON2) { | |
| 644 | my $salt = ''; | |
| 645 | $salt .= chr(int(rand(256))) for 1..16; | |
| 646 | return Crypt::Argon2::argon2id_pass($plain, $salt, 3, '32M', 1, 32); | |
| 647 | } | |
| 648 | ||
| 649 | if ($HAS_DIGEST) { | |
| 650 | my @c = ('a'..'z','A'..'Z','0'..'9'); | |
| 651 | my $salt = ''; | |
| 652 | $salt .= $c[int(rand 62)] for 1..16; | |
| 653 | my $iter = 100_000; | |
| 654 | my $hex = _iter_sha256($plain, $salt, $iter); | |
| 655 | return "iter-sha256\$$iter\$$salt\$$hex"; | |
| 656 | } | |
| 657 | ||
| 658 | return undef; | |
| 659 | } | |
| 660 | ||
| 661 | sub _verify_password { | |
| 662 | my ($plain, $stored) = @_; | |
| 663 | return 0 unless defined $plain && defined $stored; | |
| 664 | ||
| 665 | if ($stored =~ /^\$argon2/ && $HAS_ARGON2) { | |
| 666 | return eval { Crypt::Argon2::argon2id_verify($stored, $plain) } ? 1 : 0; | |
| 667 | } | |
| 668 | ||
| 669 | if ($stored =~ /^iter-sha256\$(\d+)\$([^\$]+)\$([0-9a-f]+)$/ && $HAS_DIGEST) { | |
| 670 | my ($iter, $salt, $hex) = ($1, $2, $3); | |
| 671 | my $computed = _iter_sha256($plain, $salt, $iter); | |
| 672 | return _ct_eq($computed, $hex); | |
| 673 | } | |
| 674 | ||
| 675 | return 0; | |
| 676 | } | |
| 677 | ||
| 678 | sub _iter_sha256 { | |
| 679 | my ($password, $salt, $iter) = @_; | |
| 680 | my $hash = $password; | |
| 681 | for (1 .. $iter) { | |
| 682 | $hash = Digest::SHA::sha256_hex($salt . $hash); | |
| 683 | } | |
| 684 | return $hash; | |
| 685 | } | |
| 686 | ||
| 687 | sub _ct_eq { | |
| 688 | my ($a, $b) = @_; | |
| 689 | return 0 unless defined $a && defined $b; | |
| 690 | return 0 if length($a) != length($b); | |
| 691 | my $diff = 0; | |
| 692 | for my $i (0 .. length($a) - 1) { | |
| 693 | $diff |= ord(substr($a, $i, 1)) ^ ord(substr($b, $i, 1)); | |
| 694 | } | |
| 695 | return $diff == 0 ? 1 : 0; | |
| 696 | } | |
| 697 | ||
| 698 | # --- phase3-account-state-blocklist-guard :: 2026-07-02 --- | |
| 699 | ||
| 700 | # Phase-3 helper: auto-add caller's IP to tracking_exclusions. | |
| 701 | sub _phase3_autoadd_tracking_ip { | |
| 702 | my ($db, $dbh, $DB, $config, $row) = @_; | |
| 703 | my $ip = $ENV{REMOTE_ADDR}; | |
| 704 | return unless $ip; | |
| 705 | $ip =~ s/[^0-9a-fA-F:.]//g; | |
| 706 | return unless length $ip; | |
| 707 | ||
| 708 | my $is_admin_real = $row->{is_super_admin} || $row->{_admin_is_super_admin}; | |
| 709 | my $real_uid = $row->{_admin_user_id} || $row->{user_id}; | |
| 710 | $real_uid =~ s/[^0-9]//g if defined $real_uid; | |
| 711 | ||
| 712 | if ($is_admin_real && $config->settings('auto_add_login_ip_admin')) { | |
| 713 | # Check-then-insert (INSERT IGNORE won't dedupe -- no unique key | |
| 714 | # possible on (scope, ip, user_id) because user_id is NULL for | |
| 715 | # admin scope and MariaDB treats NULLs as distinct in unique keys). | |
| 716 | my $exists = $db->db_readwrite($dbh, qq{ | |
| 717 | SELECT id FROM ${DB}.tracking_exclusions | |
| 718 | WHERE scope='admin' AND ip='$ip' AND user_id IS NULL LIMIT 1 | |
| 719 | }, $ENV{SCRIPT_NAME}, __LINE__); | |
| 720 | if (!$exists || !$exists->{id}) { | |
| 721 | $db->db_readwrite($dbh, qq{ | |
| 722 | INSERT INTO ${DB}.tracking_exclusions | |
| 723 | (scope, user_id, ip, label, source, active) | |
| 724 | VALUES ('admin', NULL, '$ip', 'auto-added on login', 'auto_login', 1) | |
| 725 | }, $ENV{SCRIPT_NAME}, __LINE__); | |
| 726 | } | |
| 727 | } | |
| 728 | elsif (!$is_admin_real && $real_uid && $config->settings('auto_add_login_ip_user')) { | |
| 729 | my $exists = $db->db_readwrite($dbh, qq{ | |
| 730 | SELECT id FROM ${DB}.tracking_exclusions | |
| 731 | WHERE scope='user' AND ip='$ip' AND user_id=$real_uid LIMIT 1 | |
| 732 | }, $ENV{SCRIPT_NAME}, __LINE__); | |
| 733 | if (!$exists || !$exists->{id}) { | |
| 734 | $db->db_readwrite($dbh, qq{ | |
| 735 | INSERT INTO ${DB}.tracking_exclusions | |
| 736 | (scope, user_id, ip, label, source, active) | |
| 737 | VALUES ('user', $real_uid, '$ip', 'auto-added on login', 'auto_login', 1) | |
| 738 | }, $ENV{SCRIPT_NAME}, __LINE__); | |
| 739 | } | |
| 740 | } | |
| 741 | } | |
| 742 | ||
| 743 | # Phase-3 helper: is this IP/email currently on the blocklist? | |
| 744 | sub _phase3_is_blocked { | |
| 745 | my ($db, $dbh, $DB, $ip, $email) = @_; | |
| 746 | my $ip_q = defined $ip ? $ip : ''; | |
| 747 | my $email_q = defined $email ? lc($email) : ''; | |
| 748 | $ip_q =~ s/[^0-9a-fA-F:.]//g; | |
| 749 | $email_q =~ s/[\\']/\\$&/g; | |
| 750 | my $domain = ''; | |
| 751 | if ($email_q =~ /\@(.+)$/) { $domain = $1; } | |
| 752 | my $sql = qq{ | |
| 753 | SELECT COUNT(*) AS n FROM ${DB}.blocklist | |
| 754 | WHERE active=1 | |
| 755 | AND ( | |
| 756 | (kind='ip' AND value='$ip_q') OR | |
| 757 | (kind='email' AND value='$email_q') OR | |
| 758 | (kind='email_domain' AND value='$domain') | |
| 759 | ) | |
| 760 | LIMIT 1 | |
| 761 | }; | |
| 762 | my $r = $db->db_readwrite($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__); | |
| 763 | return ($r && $r->{n}) ? 1 : 0; | |
| 764 | } | |
| 765 | ||
| 766 | 1; |