Diff -- /var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com/github_webhook.cgi

O Operator
Diff

/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com/github_webhook.cgi

added on local at 2026-07-01 12:34:14

Added
+174
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 7f2cd3bee049
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##################################################################################################################################
4# ______ ____ ____ ______ ______ ____ ___ __ ___ ______ _ __ ____ ____ __ __ _ __ _____ ____
5# / ____// __ \ / __ \ / ____/ / ____// __ \ / | / |/ // ____/| | / // __ \ / __ \ / //_/ | | / /|__ / / __ \
6# / / / / / // / / // __/ / /_ / /_/ // /| | / /|_/ // __/ | | /| / // / / // /_/ // ,< | | / / /_ < / / / /
7# / /___ / /_/ // /_/ // /___ / __/ / _, _// ___ | / / / // /___ | |/ |/ // /_/ // _, _// /| | | |/ / ___/ /_ / /_/ /
8# \____/ \____//_____//_____/ /_/ /_/ |_|/_/ |_|/_/ /_//_____/ |__/|__/ \____//_/ |_|/_/ |_| |___/ /____/(_)\____/
9#
10# - Written by: Shawn Pickering
11# - shawn@shawnpickering.com
12##################################################################################################################################
13use strict;
14use lib '/var/www/vhosts/3dshawn.com/ptmatrix.3dshawn.com';
15
16
17#############################################################
18## Variables
19#############################################################
20
21
22
23############################################################
24# Modules
25############################################################
26use CGI;
27$CGI::POST_MAX = 5 * 1024 * 1024;
28my $query = new CGI;
29use MODS::DBConnect; my $db = new MODS::DBConnect;
30use MODS::PTMatrix::Config; my $config = new MODS::PTMatrix::Config; my $database_name = $config->settings('database_name');
31use Digest::SHA qw(hmac_sha256_hex);
32
33
34
35############################################################
36# Program Controls
37############################################################
38$|=1;
39&webhook;
40
41
42############################################################
43# Subroutines
44############################################################
45sub resp{
46 my($code, $msg) = @_;
47 print qq~Status: $code\nContent-Type: application/json\n\n~;
48 my $m = $msg; $m =~ s/"/\\"/g;
49 print qq~{"ok":~ . ($code >= 200 && $code < 300 ? 'true' : 'false') . qq~,"msg":"$m"}~;
50 exit;
51}
52
53sub webhook{
54 #URL shape: /github_webhook.cgi?token=<webhook_token>
55 #GitHub POSTs JSON when a PR is opened / updated / closed / merged.
56 #We extract ticket references (TF-123, <prefix>-456) and upsert pr_links.
57
58 my $token = $query->url_param('token') || $query->param('token') || '';
59 $token =~ s/[^A-Za-z0-9]//g;
60 &resp(400, 'missing token') unless length $token;
61
62 my $dbh = $db->db_connect();
63 &resp(500, 'db connect failed') unless $dbh;
64
65 #------------------------------------------------------------------------------------------------------
66 #Schema gate - source_integrations table may not exist on early installs
67 my $sr = $db->db_readwrite($dbh, qq~SELECT COUNT(*) AS n FROM information_schema.TABLES WHERE TABLE_SCHEMA='${database_name}' AND TABLE_NAME='source_integrations'~, $ENV{SCRIPT_NAME}, __LINE__);
68 if(!$sr || !$sr->{n}){$db->db_disconnect($dbh); &resp(503, 'not provisioned');}
69 #------------------------------------------------------------------------------------------------------
70
71 #------------------------------------------------------------------------------------------------------
72 #Look up the integration this token belongs to
73 my $tok_q = $token; $tok_q =~ s/'/''/g;
74 my $integ = $db->db_readwrite($dbh, qq~SELECT * FROM `${database_name}`.source_integrations WHERE webhook_token='$tok_q' AND is_active=1 LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__);
75 if(!$integ || !$integ->{id}){$db->db_disconnect($dbh); &resp(404, 'unknown token');}
76 #------------------------------------------------------------------------------------------------------
77
78 #Read the raw body (need it byte-exact for signature verification)
79 binmode STDIN;
80 my $body = '';
81 my $len = $ENV{CONTENT_LENGTH} || 0;
82 read(STDIN, $body, $len) if $len;
83 $body =~ s/^payload=//; #GitHub form-encoded option
84
85 #Verify the GitHub HMAC if signing_secret is set
86 if($integ->{signing_secret} && $ENV{HTTP_X_HUB_SIGNATURE_256}){
87 my $sig = $ENV{HTTP_X_HUB_SIGNATURE_256};
88 $sig =~ s/^sha256=//;
89 my $expected = hmac_sha256_hex($body, $integ->{signing_secret});
90 if($expected ne $sig){$db->db_disconnect($dbh); &resp(401, 'signature mismatch');}
91 }
92
93 #Pull PR fields with a minimal inline parser (no JSON.pm dep)
94 my $event = lc($ENV{HTTP_X_GITHUB_EVENT} || $ENV{HTTP_X_GITLAB_EVENT} || '');
95 my $pr_num = &pluck_num($body, '"number"');
96 my $pr_url = &pluck_str($body, '"html_url"');
97 my $pr_title = &pluck_str($body, '"title"');
98 my $pr_body = &pluck_str($body, '"body"');
99 my $repo = &pluck_str($body, '"full_name"');
100 my $author = &pluck_str($body, '"login"');
101 my $state = &pluck_str($body, '"state"') || 'open';
102 my $merged = ($body =~ /"merged"\s*:\s*true/) ? 1 : 0;
103 my $draft = ($body =~ /"draft"\s*:\s*true/) ? 1 : 0;
104 $state = 'merged' if $merged;
105 $state = 'draft' if $draft;
106
107 #Ping or non-PR event - just bump the counters
108 if(!$pr_num || !$repo){
109 $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.source_integrations SET received_count=received_count+1, last_received_at=NOW(), last_error='non-PR event or unparseable payload' WHERE id='$integ->{id}'~, $ENV{SCRIPT_NAME}, __LINE__);
110 $db->db_disconnect($dbh);
111 &resp(200, 'no pr in payload (probably ping)');
112 }
113
114 #------------------------------------------------------------------------------------------------------
115 #Extract ticket refs: PFX-### style (uppercase 2-8 chars) + TaskForge#### style
116 my $hay = ($pr_title || '') . ' ' . ($pr_body || '');
117 my %refs;
118 while($hay =~ /\b([A-Z]{2,8})-(\d+)\b/g){
119 $refs{"$1-$2"} = { prefix => $1, number => $2 };
120 }
121 while($hay =~ /TaskForge#(\d+)/ig){
122 $refs{"RAW-$1"} = { prefix => undef, number => $1, raw_id => 1 };
123 }
124
125 #Resolve each ref to a real task in this company
126 my %hit;
127 foreach my $key(keys %refs){
128 my $r = $refs{$key};
129 if($r->{raw_id}){
130 my $row = $db->db_readwrite($dbh, qq~SELECT id FROM `${database_name}`.tasks WHERE id='$r->{number}' AND company_id='$integ->{company_id}' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__);
131 $hit{$row->{id}} = 1 if $row && $row->{id};
132 }else{
133 my $pq = $r->{prefix}; $pq =~ s/'/''/g;
134 my $row = $db->db_readwrite($dbh, qq~SELECT t.id FROM `${database_name}`.tasks t JOIN `${database_name}`.projects p ON p.id = t.project_id WHERE p.company_id='$integ->{company_id}' AND p.key_prefix='$pq' AND t.ticket_number='$r->{number}' LIMIT 1~, $ENV{SCRIPT_NAME}, __LINE__);
135 $hit{$row->{id}} = 1 if $row && $row->{id};
136 }
137 }
138 #------------------------------------------------------------------------------------------------------
139
140 #Upsert pr_links for each hit task
141 my $repo_q = $repo; $repo_q =~ s/'/''/g;
142 my $url_q = $pr_url || ''; $url_q =~ s/'/''/g;
143 my $title_q = $pr_title || ''; $title_q =~ s/'/''/g; $title_q = substr($title_q, 0, 500);
144 my $auth_q = $author || ''; $auth_q =~ s/'/''/g;
145
146 foreach my $tid(keys %hit){
147 $db->db_readwrite($dbh, qq~INSERT INTO `${database_name}`.pr_links SET task_id='$tid', integration_id='$integ->{id}', provider='$integ->{provider}', repo_full_name='$repo_q', pr_number='$pr_num', pr_title='$title_q', pr_url='$url_q', pr_state='$state', author_login='$auth_q', last_event_at=NOW() ON DUPLICATE KEY UPDATE pr_title='$title_q', pr_url='$url_q', pr_state='$state', author_login='$auth_q', last_event_at=NOW()~, $ENV{SCRIPT_NAME}, __LINE__);
148 }
149
150 $db->db_readwrite($dbh, qq~UPDATE `${database_name}`.source_integrations SET received_count=received_count+1, last_received_at=NOW(), last_error=NULL WHERE id='$integ->{id}'~, $ENV{SCRIPT_NAME}, __LINE__);
151 $db->db_disconnect($dbh);
152
153 &resp(200, 'linked ' . scalar(keys %hit) . ' task(s)');
154}
155
156#Minimal JSON string extract for "key":"value" - handles \" escaping
157sub pluck_str{
158 my($body, $key) = @_;
159 if($body =~ /\Q$key\E\s*:\s*"((?:[^"\\]|\\.)*)"/){
160 my $v = $1;
161 $v =~ s/\\"/"/g;
162 $v =~ s/\\n/\n/g;
163 $v =~ s/\\\\/\\/g;
164 return $v;
165 }
166 return '';
167}
168
169#Minimal JSON int extract for "key":<digits>
170sub pluck_num{
171 my($body, $key) = @_;
172 return $1 if $body =~ /\Q$key\E\s*:\s*(\d+)/;
173 return 0;
174}