Diff -- /var/www/vhosts/3dshawn.com/site1/export.cgi
Diff
/var/www/vhosts/3dshawn.com/site1/export.cgi
added on local at 2026-07-11 18:27:45
Added
+210
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 7aec7324dbf8
to 7aec7324dbf8
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 | # DriftSense -- /export.cgi | |
| 4 | # | |
| 5 | # Compliance CSV export. Two modes: | |
| 6 | # /export.cgi -> HTML picker page | |
| 7 | # /export.cgi?fmt=csv&... -> download the CSV (Content-Disposition) | |
| 8 | # | |
| 9 | # Query params: | |
| 10 | # kind = file | schema | both (default: both) | |
| 11 | # from, to = YYYY-MM-DD (default: last 90 days) | |
| 12 | # server_id = optional int (0 = all) | |
| 13 | # include_ts_only = 1 to include timestamp-only file changes | |
| 14 | #====================================================================== | |
| 15 | use strict; | |
| 16 | use warnings; | |
| 17 | use CGI (); | |
| 18 | use POSIX (); | |
| 19 | use MODS::Config; | |
| 20 | use MODS::DBConnect; | |
| 21 | use MODS::Template; | |
| 22 | use MODS::PageWrapper; | |
| 23 | ||
| 24 | my $cgi = CGI->new; | |
| 25 | my $db = MODS::DBConnect->new; | |
| 26 | my $tpl = MODS::Template->new; | |
| 27 | ||
| 28 | my $fmt = $cgi->param('fmt') || 'html'; | |
| 29 | my $kind = $cgi->param('kind') || 'both'; | |
| 30 | my $from_str = $cgi->param('from') || ''; | |
| 31 | my $to_str = $cgi->param('to') || ''; | |
| 32 | my $server_id = int($cgi->param('server_id') || 0); | |
| 33 | my $incl_ts = $cgi->param('include_ts_only') ? 1 : 0; | |
| 34 | ||
| 35 | # Normalize dates (default: last 90 days ending today) | |
| 36 | my $now = time; | |
| 37 | my $from = _parse_date($from_str) || ($now - 90 * 86400); | |
| 38 | my $to = _parse_date($to_str) || $now; | |
| 39 | $to = $to + 86400 - 1 if $to == _parse_date($to_str) && $to > 0; # end-of-day inclusive | |
| 40 | ||
| 41 | my $from_h = POSIX::strftime('%Y-%m-%d', localtime($from)); | |
| 42 | my $to_h = POSIX::strftime('%Y-%m-%d', localtime($to)); | |
| 43 | ||
| 44 | my $dbh = $db->db_connect or die "DriftSense: cannot connect to storage DB\n"; | |
| 45 | ||
| 46 | my @servers = $db->db_readwrite_multiple($dbh, q~ | |
| 47 | SELECT server_id, server_name FROM SERVERS ORDER BY server_id ASC | |
| 48 | ~, __FILE__, __LINE__); | |
| 49 | ||
| 50 | if ($fmt eq 'csv') { | |
| 51 | _emit_csv($dbh, $from, $to, $kind, $server_id, $incl_ts); | |
| 52 | $db->db_disconnect($dbh); | |
| 53 | exit; | |
| 54 | } | |
| 55 | ||
| 56 | # ---- HTML picker page ----------------------------------------------- | |
| 57 | foreach my $s (@servers) { | |
| 58 | $s->{selected} = ($server_id && $s->{server_id} == $server_id) ? 'selected' : ''; | |
| 59 | } | |
| 60 | ||
| 61 | my ($file_ct) = $db->db_readwrite($dbh, qq~ | |
| 62 | SELECT COUNT(*) AS n FROM FILE_CHANGES | |
| 63 | WHERE date_time >= FROM_UNIXTIME($from) AND date_time <= FROM_UNIXTIME($to) | |
| 64 | ~, __FILE__, __LINE__); | |
| 65 | my ($schema_ct) = $db->db_readwrite($dbh, qq~ | |
| 66 | SELECT COUNT(*) AS n FROM SCHEMA_CHANGE | |
| 67 | WHERE change_datetime >= FROM_UNIXTIME($from) AND change_datetime <= FROM_UNIXTIME($to) | |
| 68 | ~, __FILE__, __LINE__); | |
| 69 | $db->db_disconnect($dbh); | |
| 70 | ||
| 71 | my $tvars = { | |
| 72 | from_h => $from_h, | |
| 73 | to_h => $to_h, | |
| 74 | servers => \@servers, | |
| 75 | file_ct => ($file_ct && $file_ct->{n}) || 0, | |
| 76 | schema_ct => ($schema_ct && $schema_ct->{n}) || 0, | |
| 77 | kind_file_sel => $kind eq 'file' ? 'selected' : '', | |
| 78 | kind_schema_sel => $kind eq 'schema' ? 'selected' : '', | |
| 79 | kind_both_sel => $kind eq 'both' ? 'selected' : '', | |
| 80 | incl_ts_checked => $incl_ts ? 'checked' : '', | |
| 81 | }; | |
| 82 | ||
| 83 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n"; | |
| 84 | my @body = $tpl->template('export.html', $tvars); | |
| 85 | MODS::PageWrapper->new->wrapper( | |
| 86 | page_title => 'Compliance export', page_key => 'export', | |
| 87 | body_html => join('', @body), | |
| 88 | userinfo => { display_name => 'Operator' }, | |
| 89 | ); | |
| 90 | exit; | |
| 91 | ||
| 92 | #====================================================================== | |
| 93 | sub _emit_csv { | |
| 94 | my ($dbh, $from, $to, $kind, $server_id, $incl_ts) = @_; | |
| 95 | ||
| 96 | my $stamp = POSIX::strftime('%Y%m%d-%H%M%S', localtime); | |
| 97 | my $fname = "drift_sense_${kind}_${stamp}.csv"; | |
| 98 | ||
| 99 | print "Content-Type: text/csv; charset=utf-8\n"; | |
| 100 | print "Content-Disposition: attachment; filename=\"$fname\"\n"; | |
| 101 | print "Cache-Control: no-cache\n\n"; | |
| 102 | ||
| 103 | my @header = qw( | |
| 104 | change_id kind captured_at server_name target status | |
| 105 | blob_sha is_ts_only diff_url change_summary | |
| 106 | ); | |
| 107 | print _csv_row(\@header); | |
| 108 | ||
| 109 | my $public_url = MODS::Config->new->settings('public_url') || 'https://watchtower.3dshawn.com'; | |
| 110 | ||
| 111 | if ($kind eq 'file' || $kind eq 'both') { | |
| 112 | my $where = "fc.date_time >= FROM_UNIXTIME($from) AND fc.date_time <= FROM_UNIXTIME($to)"; | |
| 113 | $where .= " AND fc.is_ts_only = 0" unless $incl_ts; | |
| 114 | $where .= " AND fc.server_id = $server_id" if $server_id; | |
| 115 | ||
| 116 | # Chunked fetch to keep memory low on big exports | |
| 117 | my $last_id = 0; | |
| 118 | while (1) { | |
| 119 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 120 | SELECT fc.file_changes_id AS id, fc.file_name, fc.status, | |
| 121 | fc.date_time, fc.blob_sha, fc.is_ts_only, | |
| 122 | s.server_name | |
| 123 | FROM FILE_CHANGES fc | |
| 124 | LEFT JOIN SERVERS s ON s.server_id = fc.server_id | |
| 125 | WHERE $where AND fc.file_changes_id > $last_id | |
| 126 | ORDER BY fc.file_changes_id ASC | |
| 127 | LIMIT 5000 | |
| 128 | ~, __FILE__, __LINE__); | |
| 129 | last unless @rows; | |
| 130 | foreach my $r (@rows) { | |
| 131 | print _csv_row([ | |
| 132 | $r->{id}, | |
| 133 | 'file', | |
| 134 | $r->{date_time} // '', | |
| 135 | $r->{server_name} // 'local', | |
| 136 | $r->{file_name} // '', | |
| 137 | $r->{status} // '', | |
| 138 | $r->{blob_sha} // '', | |
| 139 | $r->{is_ts_only} ? 1 : 0, | |
| 140 | "$public_url/diff.cgi?kind=file&id=$r->{id}", | |
| 141 | '', | |
| 142 | ]); | |
| 143 | $last_id = $r->{id}; | |
| 144 | } | |
| 145 | last if @rows < 5000; | |
| 146 | } | |
| 147 | } | |
| 148 | ||
| 149 | if ($kind eq 'schema' || $kind eq 'both') { | |
| 150 | my $where = "sc.change_datetime >= FROM_UNIXTIME($from) AND sc.change_datetime <= FROM_UNIXTIME($to)"; | |
| 151 | $where .= " AND sc.server_id = $server_id" if $server_id; | |
| 152 | ||
| 153 | my $last_id = 0; | |
| 154 | while (1) { | |
| 155 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 156 | SELECT sc.schema_change_id AS id, sc.database_name, sc.table_name, | |
| 157 | sc.change_datetime, sc.changes, sc.schema_blob_sha, | |
| 158 | s.server_name | |
| 159 | FROM SCHEMA_CHANGE sc | |
| 160 | LEFT JOIN SERVERS s ON s.server_id = sc.server_id | |
| 161 | WHERE $where AND sc.schema_change_id > $last_id | |
| 162 | ORDER BY sc.schema_change_id ASC | |
| 163 | LIMIT 5000 | |
| 164 | ~, __FILE__, __LINE__); | |
| 165 | last unless @rows; | |
| 166 | foreach my $r (@rows) { | |
| 167 | my $summary = $r->{changes} // ''; | |
| 168 | $summary =~ s/\s+/ /g; | |
| 169 | $summary = substr($summary, 0, 400) if length($summary) > 400; | |
| 170 | print _csv_row([ | |
| 171 | $r->{id}, | |
| 172 | 'schema', | |
| 173 | $r->{change_datetime} // '', | |
| 174 | $r->{server_name} // 'local', | |
| 175 | ($r->{database_name} // '') . '.' . ($r->{table_name} // ''), | |
| 176 | 'ddl', | |
| 177 | $r->{schema_blob_sha} // '', | |
| 178 | 0, | |
| 179 | "$public_url/diff.cgi?kind=schema&id=$r->{id}", | |
| 180 | $summary, | |
| 181 | ]); | |
| 182 | $last_id = $r->{id}; | |
| 183 | } | |
| 184 | last if @rows < 5000; | |
| 185 | } | |
| 186 | } | |
| 187 | } | |
| 188 | ||
| 189 | #--------------------------------------------------------------------- | |
| 190 | sub _csv_row { | |
| 191 | my ($cells) = @_; | |
| 192 | my @out; | |
| 193 | foreach my $c (@$cells) { | |
| 194 | $c //= ''; | |
| 195 | if ($c =~ /[",\n\r]/) { | |
| 196 | $c =~ s/"/""/g; | |
| 197 | push @out, qq{"$c"}; | |
| 198 | } else { | |
| 199 | push @out, $c; | |
| 200 | } | |
| 201 | } | |
| 202 | return join(',', @out) . "\r\n"; | |
| 203 | } | |
| 204 | ||
| 205 | sub _parse_date { | |
| 206 | my $s = shift; | |
| 207 | return 0 unless $s && $s =~ /^(\d{4})-(\d{2})-(\d{2})$/; | |
| 208 | require Time::Local; | |
| 209 | return eval { Time::Local::timelocal(0, 0, 0, $3, $2 - 1, $1 - 1900) } || 0; | |
| 210 | } |