Diff -- /var/www/vhosts/3dshawn.com/site1/_agent_scan.pl
Diff
/var/www/vhosts/3dshawn.com/site1/_agent_scan.pl
modified on local at 2026-07-11 23:15:11
Added
+34
lines
Removed
-3
lines
Context
404
unchanged
Blobs
from e833d76d304c
to ee7754b6fe45
to ee7754b6fe45
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.| 1 | 1 | #!/usr/bin/perl |
| 2 | 2 | #====================================================================== |
| 3 | 3 | # DriftSense -- SSH agent scanner (Stealth Flavor 2) |
| 4 | 4 | # |
| 5 | 5 | # Cron entry point (NOT a CGI). For each active SERVERS row with |
| 6 | 6 | # kind='ssh_agent', SSHes into the monitored host using the configured |
| 7 | 7 | # restricted key and walks the paths in that server's FILE_MONITOR_SETTINGS. |
| 8 | 8 | # |
| 9 | 9 | # Monitored host runs zero DriftSense code -- only a single command- |
| 10 | 10 | # restricted authorized_keys entry. The wrapper on the remote side |
| 11 | 11 | # only allows 3 commands: |
| 12 | 12 | # |
| 13 | 13 | # drift-find <path> -> path\tsize\tmtime\n per file |
| 14 | 14 | # drift-hash <files> -> sha256sum output |
| 15 | 15 | # drift-read <file> -> raw bytes |
| 16 | 16 | # |
| 17 | 17 | # We drive it via SSH_ORIGINAL_COMMAND. If the wrapper isn't installed, |
| 18 | 18 | # we fall back to plain `find`, `sha256sum`, `cat` on the assumption |
| 19 | 19 | # that the SSH user has a normal shell (test-mode). |
| 20 | 20 | # |
| 21 | 21 | # Config: /etc/drift_sense/drift_sense.conf (via MODS::Config). |
| 22 | 22 | # Log: /var/log/drift_sense/agent_scan.log (via cron redirect). |
| 23 | 23 | #====================================================================== |
| 24 | 24 | use strict; |
| 25 | 25 | use warnings; |
| 26 | 26 | use lib '/var/www/vhosts/3dshawn.com/site1'; |
| 27 | 27 | use POSIX (); |
| 28 | 28 | use Digest::SHA qw(sha256_hex); |
| 29 | 29 | use Compress::Zlib qw(compress); |
| 30 | 30 | use IPC::Open3; |
| 31 | 31 | use Symbol 'gensym'; |
| 32 | 32 | use MODS::Config; |
| 33 | 33 | use MODS::DBConnect; |
| 34 | use MODS::Crypto; | |
| 35 | use Fcntl (); | |
| 34 | 36 | |
| 35 | 37 | $| = 1; |
| 36 | 38 | my $ts = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime); |
| 37 | 39 | |
| 38 | 40 | my $cfg = MODS::Config->new; |
| 39 | 41 | my $db = MODS::DBConnect->new; |
| 40 | 42 | my $dbh = $db->db_connect or die "[$ts] cannot connect to DriftSense storage DB\n"; |
| 41 | 43 | |
| 42 | 44 | my $default_max_size = int($cfg->settings('max_file_size_bytes') || 10_485_760); |
| 43 | 45 | my $DEFAULT_TIMEOUT = 30; |
| 44 | 46 | |
| 45 | 47 | # ---- Fetch ssh_agent servers ---------------------------------------- |
| 46 | 48 | my @servers = $db->db_readwrite_multiple($dbh, q~ |
| 47 | 49 | SELECT server_id, server_name, ssh_host, ssh_user, ssh_port, |
| 48 | ssh_key_path, ssh_options | |
| 50 | ssh_key_path, ssh_options, ssh_key_blob, ssh_key_enc | |
| 49 | 51 | FROM SERVERS |
| 50 | 52 | WHERE kind = 'ssh_agent' |
| 51 | 53 | AND status = 'active' |
| 52 | 54 | ~, __FILE__, __LINE__); |
| 53 | 55 | |
| 54 | 56 | unless (@servers) { |
| 55 | 57 | print "[$ts] no active ssh_agent servers, exiting\n"; |
| 56 | 58 | $db->db_disconnect($dbh); |
| 57 | 59 | exit 0; |
| 58 | 60 | } |
| 59 | 61 | |
| 60 | 62 | my $total_added = 0; |
| 61 | 63 | my $total_modified = 0; |
| 62 | 64 | my $total_deleted = 0; |
| 63 | 65 | |
| 64 | 66 | foreach my $server (@servers) { |
| 65 | 67 | my $sid = $server->{server_id}; |
| 66 | 68 | my $host = $server->{ssh_host} || next; |
| 67 | 69 | my $user = $server->{ssh_user} || 'root'; |
| 68 | 70 | my $port = $server->{ssh_port} || 22; |
| 69 | my $key = $server->{ssh_key_path} || ''; | |
| 70 | 71 | my $opts = $server->{ssh_options} || ''; |
| 71 | 72 | |
| 72 | my @ssh_base = _ssh_argv($user, $host, $port, $key, $opts); | |
| 73 | # Resolve key: prefer encrypted blob (decrypt to a mode-600 temp | |
| 74 | # file for the SSH call), else fall back to on-disk ssh_key_path. | |
| 75 | my $key_path = $server->{ssh_key_path} || ''; | |
| 76 | my $tmp_key; | |
| 77 | if ($server->{ssh_key_blob}) { | |
| 78 | my $pem = eval { MODS::Crypto::decrypt($server->{ssh_key_blob}) }; | |
| 79 | if ($pem) { | |
| 80 | $tmp_key = _materialize_key($pem); | |
| 81 | $key_path = $tmp_key if $tmp_key; | |
| 82 | } else { | |
| 83 | print "[$ts] server $server->{server_name}: key decrypt failed ($@)\n"; | |
| 84 | } | |
| 85 | } | |
| 86 | ||
| 87 | my @ssh_base = _ssh_argv($user, $host, $port, $key_path, $opts); | |
| 73 | 88 | |
| 74 | 89 | # Fetch this server's active file monitors |
| 75 | 90 | my @scans = $db->db_readwrite_multiple($dbh, qq~ |
| 76 | 91 | SELECT file_monitor_list_id, scan_path, ignore_list, file_type_filter, |
| 77 | 92 | max_file_size_bytes, scan_name |
| 78 | 93 | FROM FILE_MONITOR_SETTINGS |
| 79 | 94 | WHERE status = 1 |
| 80 | 95 | AND server_id = $sid |
| 81 | 96 | ~, __FILE__, __LINE__); |
| 82 | 97 | |
| 83 | 98 | unless (@scans) { |
| 84 | 99 | print "[$ts] server '$server->{server_name}' has no active monitors\n"; |
| 85 | 100 | next; |
| 86 | 101 | } |
| 87 | 102 | |
| 88 | 103 | my $server_err; |
| 89 | 104 | |
| 90 | 105 | foreach my $scan (@scans) { |
| 91 | 106 | my $path = $scan->{scan_path} or next; |
| 92 | 107 | my $max_size = $scan->{max_file_size_bytes} || $default_max_size; |
| 93 | 108 | |
| 94 | 109 | my %ignore_pats = _build_ignore_patterns($scan->{ignore_list}); |
| 95 | 110 | my %type_filter = _build_type_filter($scan->{file_type_filter}); |
| 96 | 111 | |
| 97 | 112 | # ---- Remote listing ----------------------------------------- |
| 98 | 113 | my $remote_cmd = qq{drift-find $path}; |
| 99 | 114 | my ($rc, $out, $err) = _ssh_run(\@ssh_base, $remote_cmd); |
| 100 | 115 | if ($rc != 0) { |
| 101 | 116 | # Fallback: no wrapper -> plain shell |
| 102 | 117 | my $shell = qq{find } . _sh_quote($path) . qq{ -type f -not -path '*/.*' -printf '%p\\t%s\\t%T@\\n' 2>/dev/null}; |
| 103 | 118 | ($rc, $out, $err) = _ssh_run(\@ssh_base, $shell); |
| 104 | 119 | } |
| 105 | 120 | if ($rc != 0) { |
| 106 | 121 | $server_err = "list failed: $err"; |
| 107 | 122 | print "[$ts] server '$server->{server_name}' scan '$scan->{scan_name}': $server_err\n"; |
| 108 | 123 | next; |
| 109 | 124 | } |
| 110 | 125 | |
| 111 | 126 | # Parse listing: path\tsize\tmtime_epoch |
| 112 | 127 | my %remote; |
| 113 | 128 | foreach my $line (split /\n/, $out) { |
| 114 | 129 | chomp $line; |
| 115 | 130 | next unless length $line; |
| 116 | 131 | my ($p, $sz, $mt) = split /\t/, $line, 3; |
| 117 | 132 | next unless defined $p && defined $sz && defined $mt; |
| 118 | 133 | $sz = int($sz); |
| 119 | 134 | $mt = int($mt); # printf gives float mtime, truncate |
| 120 | 135 | |
| 121 | 136 | # Ignore-glob filter (local side) |
| 122 | 137 | my $skip = 0; |
| 123 | 138 | for my $pat (keys %ignore_pats) { |
| 124 | 139 | my $re = $ignore_pats{$pat}; |
| 125 | 140 | if ($p =~ $re) { $skip = 1; last; } |
| 126 | 141 | } |
| 127 | 142 | next if $skip; |
| 128 | 143 | |
| 129 | 144 | # File-type filter (local side) |
| 130 | 145 | if (%type_filter) { |
| 131 | 146 | my $ext_ok = 0; |
| 132 | 147 | for my $e (keys %type_filter) { |
| 133 | 148 | if (lc(substr($p, -length($e))) eq $e) { $ext_ok = 1; last; } |
| 134 | 149 | } |
| 135 | 150 | next unless $ext_ok; |
| 136 | 151 | } |
| 137 | 152 | |
| 138 | 153 | next if $sz > $max_size; |
| 139 | 154 | $remote{$p} = { size => $sz, mtime => $mt }; |
| 140 | 155 | } |
| 141 | 156 | |
| 142 | 157 | # ---- Previous state ---------------------------------------- |
| 143 | 158 | my $prev_sth = $dbh->prepare(qq{ |
| 144 | 159 | SELECT fc.file_name, fc.blob_sha, fc.status, |
| 145 | 160 | UNIX_TIMESTAMP(fc.date_time) AS mt_epoch |
| 146 | 161 | FROM FILE_CHANGES fc |
| 147 | 162 | WHERE fc.file_monitor_list_id = $scan->{file_monitor_list_id} |
| 148 | 163 | AND fc.server_id = $sid |
| 149 | 164 | AND fc.file_changes_id IN ( |
| 150 | 165 | SELECT MAX(inner_fc.file_changes_id) |
| 151 | 166 | FROM FILE_CHANGES inner_fc |
| 152 | 167 | WHERE inner_fc.file_monitor_list_id = $scan->{file_monitor_list_id} |
| 153 | 168 | AND inner_fc.server_id = $sid |
| 154 | 169 | GROUP BY inner_fc.file_name |
| 155 | 170 | ) |
| 156 | 171 | }); |
| 157 | 172 | my %prev; |
| 158 | 173 | if ($prev_sth && $prev_sth->execute) { |
| 159 | 174 | while (my $r = $prev_sth->fetchrow_hashref) { |
| 160 | 175 | $prev{$r->{file_name}} = $r; |
| 161 | 176 | } |
| 162 | 177 | $prev_sth->finish; |
| 163 | 178 | } |
| 164 | 179 | |
| 165 | 180 | # ---- Decide who needs a fresh hash -------------------------- |
| 166 | 181 | my @needs_hash; |
| 167 | 182 | foreach my $p (keys %remote) { |
| 168 | 183 | my $prev_row = $prev{$p}; |
| 169 | 184 | if (!$prev_row || ($prev_row->{status} // '') eq 'deleted') { |
| 170 | 185 | push @needs_hash, $p; |
| 171 | 186 | next; |
| 172 | 187 | } |
| 173 | 188 | if (($prev_row->{mt_epoch} // 0) != $remote{$p}{mtime}) { |
| 174 | 189 | push @needs_hash, $p; |
| 175 | 190 | } |
| 176 | 191 | } |
| 177 | 192 | |
| 178 | 193 | # ---- Batch hash over SSH ----------------------------------- |
| 179 | 194 | # `drift-hash <files>` returns sha256sum output: "<sha> <path>" |
| 180 | 195 | my %fresh_sha; |
| 181 | 196 | if (@needs_hash) { |
| 182 | 197 | my $q_list = join(' ', map { _sh_quote($_) } @needs_hash); |
| 183 | 198 | my $cmd = "drift-hash $q_list"; |
| 184 | 199 | my ($h_rc, $h_out, $h_err) = _ssh_run(\@ssh_base, $cmd); |
| 185 | 200 | if ($h_rc != 0) { |
| 186 | 201 | # Fallback: plain sha256sum |
| 187 | 202 | $cmd = "sha256sum $q_list 2>/dev/null"; |
| 188 | 203 | ($h_rc, $h_out, $h_err) = _ssh_run(\@ssh_base, $cmd); |
| 189 | 204 | } |
| 190 | 205 | if ($h_rc == 0) { |
| 191 | 206 | foreach my $line (split /\n/, $h_out) { |
| 192 | 207 | chomp $line; |
| 193 | 208 | if ($line =~ /^([0-9a-f]{64})\s+(.+)$/) { |
| 194 | 209 | $fresh_sha{$2} = $1; |
| 195 | 210 | } |
| 196 | 211 | } |
| 197 | 212 | } |
| 198 | 213 | } |
| 199 | 214 | |
| 200 | 215 | # ---- Process each remote file ------------------------------ |
| 201 | 216 | foreach my $p (keys %remote) { |
| 202 | 217 | my $sha = $fresh_sha{$p}; |
| 203 | 218 | my $prev_row = $prev{$p}; |
| 204 | 219 | |
| 205 | 220 | # If we didn't rehash this file, previous SHA still valid |
| 206 | 221 | if (!defined $sha && $prev_row && ($prev_row->{status} // '') ne 'deleted') { |
| 207 | 222 | # Nothing changed since last tick -- move on |
| 208 | 223 | next; |
| 209 | 224 | } |
| 210 | 225 | |
| 211 | 226 | # Content-addressable dedup: if we already have this SHA in |
| 212 | 227 | # BLOB_STORE, don't re-fetch content over SSH. |
| 213 | 228 | my $have = $db->db_readwrite($dbh, |
| 214 | 229 | "SELECT blob_sha FROM BLOB_STORE WHERE blob_sha = " . $dbh->quote($sha) . " LIMIT 1", |
| 215 | 230 | __FILE__, __LINE__); |
| 216 | 231 | |
| 217 | 232 | my $status; |
| 218 | 233 | if (!$prev_row) { |
| 219 | 234 | $status = 'added'; |
| 220 | 235 | } else { |
| 221 | 236 | $status = 'modified'; |
| 222 | 237 | if ($prev_row->{blob_sha} && $prev_row->{blob_sha} eq $sha) { |
| 223 | 238 | # Same bytes, just an mtime touch -- flag ts-only |
| 224 | 239 | $status = 'modified'; |
| 225 | 240 | } |
| 226 | 241 | } |
| 227 | 242 | |
| 228 | 243 | # Fetch + store blob only if we don't already have it |
| 229 | 244 | if (!($have && $have->{blob_sha})) { |
| 230 | 245 | my $cmd = 'drift-read ' . _sh_quote($p); |
| 231 | 246 | my ($c_rc, $c_out, $c_err) = _ssh_run(\@ssh_base, $cmd); |
| 232 | 247 | if ($c_rc != 0) { |
| 233 | 248 | $cmd = 'cat ' . _sh_quote($p); |
| 234 | 249 | ($c_rc, $c_out, $c_err) = _ssh_run(\@ssh_base, $cmd); |
| 235 | 250 | } |
| 236 | 251 | if ($c_rc != 0) { |
| 237 | 252 | print "[$ts] fetch $p on $server->{server_name}: $c_err\n"; |
| 238 | 253 | next; |
| 239 | 254 | } |
| 240 | 255 | # Verify the fetched content matches the reported hash |
| 241 | 256 | my $verify_sha = sha256_hex($c_out); |
| 242 | 257 | if ($verify_sha ne $sha) { |
| 243 | 258 | print "[$ts] $p: hash mismatch (list=$sha vs read=$verify_sha), using read\n"; |
| 244 | 259 | $sha = $verify_sha; |
| 245 | 260 | } |
| 246 | 261 | _store_blob($db, $dbh, $sha, $c_out); |
| 247 | 262 | } |
| 248 | 263 | |
| 249 | 264 | # Determine timestamp-only via prev SHA compare |
| 250 | 265 | my $is_ts_only = 0; |
| 251 | 266 | if ($prev_row && $prev_row->{blob_sha} && $prev_row->{blob_sha} eq $sha) { |
| 252 | 267 | $is_ts_only = 1; |
| 253 | 268 | } |
| 254 | 269 | |
| 255 | 270 | # Insert FILE_CHANGES row keyed to this server |
| 256 | 271 | my $q_file = $dbh->quote($p); |
| 257 | 272 | my $q_sha = $dbh->quote($sha); |
| 258 | 273 | my $q_stat = $dbh->quote($status); |
| 259 | 274 | my $mt = $remote{$p}{mtime}; |
| 260 | 275 | $db->db_readwrite($dbh, qq{ |
| 261 | 276 | INSERT INTO FILE_CHANGES |
| 262 | 277 | (file_monitor_list_id, server_id, container_target_id, |
| 263 | 278 | file_name, blob_sha, is_ts_only, date_time, status) |
| 264 | 279 | VALUES |
| 265 | 280 | ($scan->{file_monitor_list_id}, $sid, NULL, |
| 266 | 281 | $q_file, $q_sha, $is_ts_only, |
| 267 | 282 | FROM_UNIXTIME($mt), $q_stat) |
| 268 | 283 | }, __FILE__, __LINE__); |
| 269 | 284 | |
| 270 | 285 | if ($is_ts_only) { } |
| 271 | 286 | elsif ($status eq 'added') { $total_added++; } |
| 272 | 287 | else { $total_modified++; } |
| 273 | 288 | } |
| 274 | 289 | |
| 275 | 290 | # ---- Delete detection -------------------------------------- |
| 276 | 291 | foreach my $p (keys %prev) { |
| 277 | 292 | next if $remote{$p}; |
| 278 | 293 | next if ($prev{$p}{status} // '') eq 'deleted'; |
| 279 | 294 | my $q_file = $dbh->quote($p); |
| 280 | 295 | $db->db_readwrite($dbh, qq{ |
| 281 | 296 | INSERT INTO FILE_CHANGES |
| 282 | 297 | (file_monitor_list_id, server_id, file_name, status, date_time) |
| 283 | 298 | VALUES |
| 284 | 299 | ($scan->{file_monitor_list_id}, $sid, $q_file, 'deleted', NOW()) |
| 285 | 300 | }, __FILE__, __LINE__); |
| 286 | 301 | $total_deleted++; |
| 287 | 302 | } |
| 288 | 303 | |
| 289 | 304 | $db->db_readwrite($dbh, qq{ |
| 290 | 305 | UPDATE FILE_MONITOR_SETTINGS |
| 291 | 306 | SET last_scanned = NOW() |
| 292 | 307 | WHERE file_monitor_list_id = $scan->{file_monitor_list_id} |
| 293 | 308 | }, __FILE__, __LINE__); |
| 294 | 309 | } |
| 295 | 310 | |
| 296 | 311 | # Server-level bookkeeping |
| 297 | 312 | my $q_err = $dbh->quote($server_err || ''); |
| 298 | 313 | $db->db_readwrite($dbh, qq{ |
| 299 | 314 | UPDATE SERVERS |
| 300 | 315 | SET last_agent_scan_at = NOW(), |
| 301 | 316 | last_agent_error = $q_err, |
| 302 | 317 | last_heartbeat_at = NOW() |
| 303 | 318 | WHERE server_id = $sid |
| 304 | 319 | }, __FILE__, __LINE__); |
| 320 | ||
| 321 | # Clean up decrypted-key temp file | |
| 322 | unlink $tmp_key if $tmp_key && $tmp_key =~ m!^/tmp/\.ds_agent_key_!; | |
| 305 | 323 | } |
| 306 | 324 | |
| 307 | 325 | $db->db_disconnect($dbh); |
| 308 | 326 | print "[$ts] agent scan complete: +$total_added added, ~$total_modified modified, -$total_deleted deleted\n" |
| 309 | 327 | if ($total_added + $total_modified + $total_deleted) > 0; |
| 310 | 328 | exit 0; |
| 311 | 329 | |
| 312 | 330 | #--------------------------------------------------------------------- |
| 313 | 331 | sub _ssh_argv { |
| 314 | 332 | my ($user, $host, $port, $key, $opts) = @_; |
| 315 | 333 | my @a = ('/usr/bin/ssh', |
| 316 | 334 | '-o', 'BatchMode=yes', |
| 317 | 335 | '-o', 'StrictHostKeyChecking=no', |
| 318 | 336 | '-o', 'UserKnownHostsFile=/dev/null', |
| 319 | 337 | '-o', 'LogLevel=ERROR', |
| 320 | 338 | '-o', 'ConnectTimeout=8', |
| 321 | 339 | '-p', $port); |
| 322 | 340 | if ($key && -r $key) { |
| 323 | 341 | push @a, '-i', $key; |
| 324 | 342 | } |
| 325 | 343 | if ($opts) { |
| 326 | 344 | # Space-separated -o key=value pairs |
| 327 | 345 | foreach my $o (split /\s+/, $opts) { |
| 328 | 346 | push @a, '-o', $o if length $o; |
| 329 | 347 | } |
| 330 | 348 | } |
| 331 | 349 | push @a, "$user\@$host"; |
| 332 | 350 | return @a; |
| 333 | 351 | } |
| 334 | 352 | |
| 335 | 353 | sub _ssh_run { |
| 336 | 354 | my ($base, $cmd) = @_; |
| 337 | 355 | my @argv = (@$base, $cmd); |
| 338 | 356 | my ($wtr, $rdr, $err_fh); |
| 339 | 357 | $err_fh = gensym; |
| 340 | 358 | my $pid = eval { open3($wtr, $rdr, $err_fh, @argv) }; |
| 341 | 359 | return (-1, '', $@) if $@ || !$pid; |
| 342 | 360 | close $wtr; |
| 343 | 361 | binmode $rdr; |
| 344 | 362 | my $out = do { local $/; <$rdr> // '' }; |
| 345 | 363 | my $err = do { local $/; <$err_fh> // '' }; |
| 346 | 364 | close $rdr; close $err_fh; |
| 347 | 365 | waitpid $pid, 0; |
| 348 | 366 | my $rc = $? >> 8; |
| 349 | 367 | return ($rc, $out, $err); |
| 368 | } | |
| 369 | ||
| 370 | sub _materialize_key { | |
| 371 | my ($pem) = @_; | |
| 372 | return undef unless defined $pem && length $pem; | |
| 373 | my $t = POSIX::strftime('%s', localtime); | |
| 374 | my $path = "/tmp/.ds_agent_key_${t}_$$_" . int(rand(1_000_000)); | |
| 375 | sysopen(my $fh, $path, | |
| 376 | Fcntl::O_WRONLY() | Fcntl::O_CREAT() | Fcntl::O_EXCL(), | |
| 377 | 0600) or return undef; | |
| 378 | print $fh $pem; | |
| 379 | close $fh; | |
| 380 | return $path; | |
| 350 | 381 | } |
| 351 | 382 | |
| 352 | 383 | sub _sh_quote { |
| 353 | 384 | my $s = shift; $s //= ''; |
| 354 | 385 | # Single-quote and escape internal single quotes |
| 355 | 386 | $s =~ s/'/'\\''/g; |
| 356 | 387 | return "'$s'"; |
| 357 | 388 | } |
| 358 | 389 | |
| 359 | 390 | sub _build_ignore_patterns { |
| 360 | 391 | my $list = shift; |
| 361 | 392 | my %out; |
| 362 | 393 | return %out unless $list; |
| 363 | 394 | for my $ig (split /[,\n]+/, $list) { |
| 364 | 395 | $ig =~ s/^\s+|\s+$//g; |
| 365 | 396 | next unless length $ig; |
| 366 | 397 | my $re = quotemeta $ig; |
| 367 | 398 | $re =~ s/\\\*/.*/g; |
| 368 | 399 | $re =~ s/\\\?/./g; |
| 369 | 400 | $out{$ig} = qr/$re/; |
| 370 | 401 | } |
| 371 | 402 | return %out; |
| 372 | 403 | } |
| 373 | 404 | |
| 374 | 405 | sub _build_type_filter { |
| 375 | 406 | my $list = shift; |
| 376 | 407 | my %out; |
| 377 | 408 | return %out unless $list && length $list; |
| 378 | 409 | for my $ext (split /,/, $list) { |
| 379 | 410 | $ext =~ s/^\s+|\s+$//g; |
| 380 | 411 | next unless length $ext; |
| 381 | 412 | $ext = ".$ext" unless $ext =~ /^\./; |
| 382 | 413 | $out{lc $ext} = 1; |
| 383 | 414 | } |
| 384 | 415 | return %out; |
| 385 | 416 | } |
| 386 | 417 | |
| 387 | 418 | sub _store_blob { |
| 388 | 419 | my ($db, $dbh, $sha, $content) = @_; |
| 389 | 420 | my $existing = $db->db_readwrite($dbh, |
| 390 | 421 | "SELECT blob_sha FROM BLOB_STORE WHERE blob_sha = " . $dbh->quote($sha) . " LIMIT 1", |
| 391 | 422 | __FILE__, __LINE__); |
| 392 | 423 | if ($existing && $existing->{blob_sha}) { |
| 393 | 424 | $db->db_readwrite($dbh, |
| 394 | 425 | "UPDATE BLOB_STORE SET ref_count = ref_count + 1 WHERE blob_sha = " . $dbh->quote($sha), |
| 395 | 426 | __FILE__, __LINE__); |
| 396 | 427 | return; |
| 397 | 428 | } |
| 398 | 429 | my $gz = compress($content) // ''; |
| 399 | 430 | my $sth = $dbh->prepare(qq{ |
| 400 | 431 | INSERT INTO BLOB_STORE (blob_sha, content_gz, size_uncompressed, size_compressed, ref_count, first_seen_at) |
| 401 | 432 | VALUES (?, ?, ?, ?, 1, NOW()) |
| 402 | 433 | }); |
| 403 | 434 | if ($sth) { |
| 404 | 435 | $sth->execute($sha, $gz, length($content), length($gz)); |
| 405 | 436 | $sth->finish; |
| 406 | 437 | } |
| 407 | 438 | } |