├── .gitignore ├── .gitattributes ├── Exit.aplf ├── SSGChanges.dcfg ├── MantisAPI.aplf ├── ISOtoDN.aplf ├── DevConfig.dcfg ├── SendMail.aplf ├── Sha256.aplf ├── TSFmtNice.aplf ├── OpenLogFile.aplf ├── Run.aplf ├── README.md ├── LICENSE ├── HtmlTable.aplf ├── MonitorConfig.csv ├── InitGlobals.aplf ├── DyalogSecurityIssues.aplf ├── ThirdPartyVulnerabilities.aplf └── HttpCommand.aplc /.gitignore: -------------------------------------------------------------------------------- 1 | SSGDEBUG.apla 2 | DevDb/* 3 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | * text=auto 2 | 3 | *.aplf text 4 | *.json text 5 | -------------------------------------------------------------------------------- /Exit.aplf: -------------------------------------------------------------------------------- 1 | Exit code 2 | ('Runtime would have exited with code ',⍕code)⎕SIGNAL SSGDEBUG/11 3 | ⎕OFF code -------------------------------------------------------------------------------- /SSGChanges.dcfg: -------------------------------------------------------------------------------- 1 | { 2 | Extend: "Run.dcfg", 3 | 4 | Settings: { 5 | SSG: { 6 | INTERVAL: 0 // Changes since last run 7 | } 8 | } 9 | } 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /MantisAPI.aplf: -------------------------------------------------------------------------------- 1 | r←MantisAPI url;headers;api;resp 2 | api←'https://mantis.dyalog.com/api/rest/' 3 | headers←1 2⍴'Authorization'MANTISAPITOKEN 4 | resp←HttpCommand.Get(api,url)''headers 5 | :If resp.rc∊0 ¯1 6 | r←resp.Data 7 | :Else 8 | (⍕r)⎕SIGNAL 11 9 | :EndIf 10 | -------------------------------------------------------------------------------- /ISOtoDN.aplf: -------------------------------------------------------------------------------- 1 | ISOtoDN←{ ⍝ "2021-07-22T10:20:39+01:00" to Day Number (1 ⎕DT) 2 | 25≠≢⍵:'Invalid ISO timestamp' ⎕SIGNAL 11 3 | nums←2⊃'-+:T' ⎕VFI ⍵ ⍝ All numeric fields 4 | bad←⍵[5 8 11 14 17 23]≢'--T:::' 5 | bad∨←~(sign←⍵[20])∊'+-' 6 | bad∨8≠≢nums:'Invalid ISO timestamp' ⎕SIGNAL 11 7 | utcoff←(60⊥¯2↑nums)÷1440ׯ1*'+'=sign 8 | utcoff+1 ⎕DT ⊂6↑nums 9 | } 10 | -------------------------------------------------------------------------------- /DevConfig.dcfg: -------------------------------------------------------------------------------- 1 | {// Default/development SSG configuration file 2 | // Set SSG_CONFIG env var to use a different configuration 3 | // Or set any of the following parameters in ENV vars or command line to override 4 | DATABASE: "DevDb", 5 | INTERVAL: -1, // Report All Security Issues 6 | // 0 means report changes since last run 7 | MAILSERVER: "mail.dyalog.com", 8 | MAILFROM: "mkrom@dyalog.com", // nightly@dyalog.com in production 9 | MAILTO: "mkrom@dyalog.com", // ssg@dyalog.com 10 | } 11 | -------------------------------------------------------------------------------- /SendMail.aplf: -------------------------------------------------------------------------------- 1 | SendMail (mailserver sender password recipient subject body);smtp;M;⎕USING 2 | ⍝ Send message using .NET Core 3 | 4 | ⍝ mailserver←'mail.dyalog.com' 5 | ⍝ sender←'mkrom@dyalog.com' 6 | ⍝ recipient←'mkrom@dyalog.com' 7 | ⍝ password←'…' 8 | ⍝ subject←'Hello from Morten' 9 | ⍝ body←'This is a test e-mail message' 10 | 11 | ⎕USING←'System.Net,System.Net.Mail' 'System.Net,System.Net.Primitives' ⍝ .NET Core 12 | 13 | smtp←⎕NEW Mail.SmtpClient(⊂mailserver) 14 | smtp.Port←26 15 | smtp.Credentials←⎕NEW NetworkCredential (sender password) 16 | 17 | M←⎕NEW Mail.MailMessage(sender recipient subject (∊body)) 18 | M.IsBodyHtml←1 19 | smtp.Send M 20 | -------------------------------------------------------------------------------- /Sha256.aplf: -------------------------------------------------------------------------------- 1 | r←Sha256 data;ctx;Init;Update;digest;Digest;platform;libssl;lib;ext 2 | platform←⎕C 3↑⊃'.'⎕WG'APLVersion' 3 | :Select platform 4 | :Case 'win' 5 | lib ext←⊂'' 6 | :Case 'lin' 7 | lib ext←'lib' '.so' 8 | :Case 'mac' 9 | lib ext←'lib' '.dylib' 10 | :Case 'aix' 11 | lib ext←'lib' '.a' 12 | :EndSelect 13 | libssl←lib,'conga34ssl64',ext 14 | 'Init'⎕NA libssl,'|nettle_sha256_init >I1[112] ' 15 | 'Update'⎕NA libssl,'|nettle_sha256_update =I1[112] U8 I1[32]' 17 | 18 | ctx←Init 112 19 | ctx←Update ctx(⍴data)data 20 | ctx digest←Digest ctx 32 32 21 | 22 | r←digest 23 | -------------------------------------------------------------------------------- /TSFmtNice.aplf: -------------------------------------------------------------------------------- 1 | r←{now} TSFmtNice ts;now;yday;today;z;i;m;idn;s;tomorrow;later;ix;w 2 | ⍝ Format a vector of 1 ⎕DT's nicely 3 | 4 | :If 0=⎕NC 'now' ⋄ now←1 ⎕DT'J' ⋄ :EndIf ⍝ Default to local time 5 | s←⍴ts 6 | later←1+tomorrow←2+yday←¯1+today←⌊now 7 | r←16↑⍤1⊢↑'DD Mmm hh:mm'(1200⌶)ts←,ts ⍝ Make matrix 8 | :If 0≠≢i←⍸m←1 2 3∊⍨ix←+/ts∘.≥yday,today,tomorrow,later 9 | r[i;]←r[i;7+⍳5],' ',(3 10⍴'yesterday today tomorrow ')[ix[i];] 10 | :EndIf 11 | r[i;7+⍳5]←↑5↑¨'YYYY'(1200⌶)ts[i←⍸~m] ⍝ Replace time by year if longer ago 12 | :If 0≠⍴i←((z>0)∧100>z←⌊(now-ts)×24×60)/⍳⍴ts 13 | r[i;]←16↑[2]↑(⍕¨⌊z[i]),¨(' minutes ago' ' minute ago')[1+1=z[i]] 14 | :EndIf 15 | :If 0≠⍴i←(1>|z)/⍳⍴ts 16 | r[i;]←((⍴i),16)⍴16↑'Now' 17 | :EndIf 18 | :If 0≠⍴i←(ts=0)/⍳⍴ts 19 | r[i;]←((⍴i),16)⍴16↑'Unknown' 20 | :EndIf 21 | 22 | r←s⍴(+/∨\' '≠⌽r)↑¨↓r 23 | -------------------------------------------------------------------------------- /OpenLogFile.aplf: -------------------------------------------------------------------------------- 1 | (tn msg)←OpenLogFile LOGFILE;logdir;NL 2 | ⍝ Return tie number and empty msg on success, else (0 message) 3 | (tn msg)←0 '' 4 | NL←⎕UCS 10 5 | 6 | :If ⎕NEXISTS LOGFILE 7 | :Trap 0 8 | tn←LOGFILE ⎕FTIE 0 9 | :Else 10 | msg←'ERROR: error attempting to ⎕ftie LOGFILE ',LOGFILE,NL 11 | msg,←⎕JSON ⎕DMX 12 | :EndTrap 13 | :Else 14 | :Trap (~SSGDEBUG)/0 15 | logdir←⊃1 ⎕NPARTS LOGFILE 16 | ⍝ ROS points out that ⎕nexists⋄12⎕ninfo has a timing hole, so safer to trap error if logdir doesn't exist 17 | :If ~12 ⎕NINFO logdir ⍝ 12: Is file/folder writable? 18 | msg←'ERROR: Unable to write to existant log directory ',logdir 19 | :EndIf 20 | :Else 21 | msg←'ERROR: log directory',logdir,' does not exist' 22 | :EndTrap 23 | 24 | tn←LOGFILE ⎕FCREATE 0 25 | (1 3⍴0 ¯1 0)⎕FSTAC tn 26 | ⎕←'Created log file "',LOGFILE,'"' 27 | 'Security Monitor Log File v1.0'⎕FAPPEND tn 28 | (9⍴⊂'reserved')⎕FAPPEND¨tn 29 | :EndIf 30 | -------------------------------------------------------------------------------- /Run.aplf: -------------------------------------------------------------------------------- 1 | Run dummy;msg;Exit;m 2 | ⍝ Use Exit Code of 10 for success, 3 | ⍝ 12 for expected failures, 4 | ⍝ 13 for global unexpected errors 5 | 6 | ⎕PW←1000 7 | :If 0=⎕NC 'SSGDEBUG' ⋄ SSGDEBUG←0 ⋄ :EndIf 8 | Exit←{SSGDEBUG:('Runtime would have exited with code ',⍕⍵)⎕SIGNAL 11 ⋄ ⎕OFF ⍵} 9 | 10 | :Trap SSGDEBUG↓0 11 | :If 1 1≢2↑m←2250⌶0 12 | ⎕←'ERROR: .NET Core is not available, unable to send e-mail.' 13 | ⎕←' 2250⌶0 returned ',m 14 | Exit 12 15 | :EndIf 16 | InitGlobals 17 | :if POLLTYPE≢'thirdparty' 18 | ⎕←'Checking Mantis' 19 | :If 0≠≢msg←DyalogSecurityIssues INTERVAL ⋄ ⎕←msg ⋄ :EndIf 20 | :EndIf 21 | :if POLLTYPE≢'mantis' 22 | ⎕←'Checking third party sites' 23 | :If 0≠≢msg←ThirdPartyVulnerabilities INTERVAL ⋄ ⎕←msg ⋄ :EndIf 24 | :EndIf 25 | Exit 10 26 | :Else 27 | 28 | ⎕←'ERROR: Unexpected error in SSGMon' 29 | ⎕←⎕JSON⍠'Compact' 0⊢⎕DMX 30 | :If ⎕EN=90 31 | ⎕←⎕EXCEPTION 32 | :EndIf 33 | Exit 13 34 | :EndTrap 35 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # SSGMon 2 | The Dyalog Security Group's Security Issue Monitor - SSGMon - has been developed by Dyalog to monitor: 3 | 4 | * Published security issues related to third party software that is used or re-distributed by Dyalog 5 | * Issues tagged as "security related" in our internal issue tracking system Mantis 6 | 7 | SSGMon is run at regular intervals in a mode where it sends e-mail summarising changes since the last run. It also runs once a week in the mode where it provides an overview of all open security issues and a list of the third party components that are being tracked. 8 | 9 | By setting "polltype=[both|mantis|thirdparty]" on the Dyalog command line, you can control which information is checked and sent - it is not necessary to run both Mantis and 3rd party reports each time. 10 | 11 | SSGMon is for internal use at Dyalog, but the repository is public so that the code can be used as inspiration for anyone needing to do something similar. For Dyalogers: you will also need the files in JenkinsBuild/SSGMon_External_Files. 12 | 13 | It is provided "as is" and without documentation under MIT licence. 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2024 Dyalog Ltd. 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /HtmlTable.aplf: -------------------------------------------------------------------------------- 1 | HTML←{ALIGN}HtmlTable RCV;ROWTITLES;COLTITLES;VALUES;CRLF;TAB;class;colours;c;tr;thstyle 2 | ⍝ LEFT|RIGHT|CENTER HTMLTable RowTitles ColTitles Data 3 | 4 | class←'' 5 | CRLF←⎕UCS 13 10 6 | colours←'#d8edeb' '#f5fcfc' 7 | 8 | :If 0=⎕NC'ALIGN' 9 | ALIGN←'left' 10 | :EndIf 11 | 12 | (ROWTITLES COLTITLES VALUES)←RCV 13 | :If 1=≡ALIGN 14 | VALUES←(⊂''),¨VALUES,¨(⊂'',CRLF) 15 | :Else 16 | ALIGN←(⍴VALUES)⍴ALIGN 247 17 | VALUES←(⊂''),¨VALUES,¨(⊂'',CRLF) 18 | :EndIf 19 | 20 | HTML←'',CRLF 21 | thstyle←' style="background-color:',(2⊃colours),'"' 22 | 23 | :If ''≢COLTITLES 24 | :AndIf ''≢ROWTITLES 25 | HTML,←'',CRLF 26 | :EndIf 27 | 28 | :If ''≢COLTITLES 29 | COLTITLES←(⊂'',CRLF) 30 | HTML,←∊COLTITLES 31 | :EndIf 32 | 33 | HTML,←'',CRLF 34 | 35 | tr←'',CRLF 36 | :If ROWTITLES≡'' 37 | HTML,←∊tr,VALUES,⊂'',CRLF 38 | :Else 39 | ROWTITLES←(⊂'',CRLF) 40 | HTML,←∊tr,ROWTITLES,VALUES,⊂'',CRLF 41 | :EndIf 42 | 43 | HTML,←'
 '),¨COLTITLES,¨(⊂'
'),¨ROWTITLES,¨(⊂'
',CRLF 44 | -------------------------------------------------------------------------------- /MonitorConfig.csv: -------------------------------------------------------------------------------- 1 | "Component" ,"CPE" ,"URL" 2 | "GnuTLS" ,"a:gnu:gnutls:3.6.5" ,"gnutls.org/news.atom" 3 | "OpenSSL" ,"a:openssl:openssl:1.0.1g" ,"www.openssl.org/news/vulnerabilities/index.html" 4 | "LibNettle" ,"a:nettle_project:nettle:3.4.1","git.lysator.liu.se/nettle/nettle.atom" 5 | "PCRE" ,"a:pcre:pcre:8.45" ,"" 6 | "dbl-cnv" ,"" ,"github.com/google/double-conversion/security/advisories" 7 | "GMPLIB" ,"a:gmplib:gmp:6.1.2" ,"gmplib.org/" 8 | "unixODBC" ,"a:unixodbc:unixodbc:2.3.1" ,"github.com/lurcher/unixODBC/security/advisories" 9 | "LZ4" ,"a:lz4_project:lz4:1.9.2" ,"" 10 | "zlib12" ,"a:zlib:zlib:1.2.11" ,"" 11 | "zlib13" ,"a:zlib:zlib:1.3" ,"" 12 | "cef" ,"a:chromiumembedded:chromium_embedded_framework:-" ,"" 13 | "StackWalker","" ,"github.com/JochenKalmbach/StackWalker/security/advisories" 14 | "SharpZipLib","a:sharpziplib_project:sharpziplib:-","" 15 | "NGif" ,"" ,"github.com/avianbc/NGif/security/advisories" 16 | "Boost" ,"a:boost:boost:1.72.0" ,"" 17 | "StatsLib" ,"" ,"github.com/kthohr/stats/security/advisories" 18 | "GCE-Math" ,"" ,"github.com/kthohr/gcem/security/advisories" 19 | "Dracula" ,"" ,"github.com/taniarascia/new-moon/security/advisories" 20 | "ILPack" ,"" ,"github.com/Lokad/ILPack/security/advisories" 21 | "ANGLE" ,"a:google:angle:-" ,"" 22 | -------------------------------------------------------------------------------- /InitGlobals.aplf: -------------------------------------------------------------------------------- 1 | InitGlobals;env;dir;configfile;cfg;root;config 2 | ⍝ Initialise control variables 3 | 4 | env←{⍺←'' ⋄ 0=≢r←2 ⎕NQ'.' 'GetEnvironment'⍵:⍺ ⋄ r} 5 | cfg←{⍺←'' ⋄ 0=config.⎕NC ⍵:⍺ ⋄ config⍎⍵} 6 | 7 | ⍝ From config files 8 | root←⊃⎕NPARTS 4⊃5179⌶⊃⎕SI 9 | configfile←(root,'DevConfig.dcfg') env 'SSGMON_CONFIGFILE' 10 | :If ~⎕NEXISTS configfile 11 | ⎕←'Unable to find configuration file "',configfile,'"' 12 | Exit 12 13 | :EndIf 14 | 15 | ⍝ Originally the variables in the next block were pulled from the config 16 | ⍝ namespace which came from the config file, but this doesn't allow 17 | ⍝ the use of such as [WORKSPACE]/mydir - so just use env instead 18 | ⍝ config←0 ⎕JSON⍠'Dialect' 'JSON5'⊣⊃⎕NGET configfile 19 | 20 | DATABASE← 'DevDb' env 'DATABASE' 21 | INTERVAL← '-1' env 'INTERVAL' ⍝ Default: Report all issues 22 | MAILSERVER←'mail.dyalog.com' env 'MAILSERVER' 23 | MAILFROM← 'mkrom@dyalog.com' env 'MAILFROM' 24 | MAILTO← 'mkrom@dyalog.com' env 'MAILTO' 25 | POLLTYPE← 'both' env 'POLLTYPE' ⍝ Can be 'both', 'mantis' or 'thirdparty' 26 | SSGDEBUG← ⎕JSON '0' env 'DEBUG' 27 | 28 | INTERVAL←⍬⍴⊃(//)⎕vfi '¯'@{⍵='-'}⊢INTERVAL ⍝ Possibly ought to do more checking here 29 | 30 | ⍝ MK and AWS agree that we force the use of MonitorConfig.csv from the code 31 | ⍝ directory so that changes can be committed, given us the history. 32 | MONITORCFG←root,'MonitorConfig.csv' 33 | 34 | ⍝ From environment: DO NOT PUT THESE in config! 35 | SMTPPASS← env 'SMTP_PWD' 36 | MANTISAPITOKEN← env 'MANTIS_TKN' 37 | 38 | DATABASE←((~∨/'/\:'∊2↑DATABASE)/root),DATABASE 39 | -------------------------------------------------------------------------------- /DyalogSecurityIssues.aplf: -------------------------------------------------------------------------------- 1 | r←DyalogSecurityIssues interval;f;i;new;cols;old;tn;now;then;msg;subject;ns;tbl;tsfmt;gone;when;m;last;cn;added;changed;issues;timestamp;out;resolved;nums;rows;p;n;ignore;drop;size;fileok;ix 2 | ⍝ Send SSGMon e-mail 3 | ⍝ r is empty on success, else error message 4 | ⍝ if interval=¯1, report all open issues (weekly run) 5 | ⍝ if interval=0, issues modified since last run (regardless of status) 6 | 7 | subject←'Error' ⍝ If anything goes wrong en route 8 | :If ∨/m←0=≢¨MAILSERVER MAILFROM SMTPPASS MAILTO DATABASE SMTPPASS MANTISAPITOKEN 9 | r←'Missing configuration: ',⍕m/' '(=⊂⊢) ' MAILSERVER MAILFROM SMTPPASS MAILTO LOGFILE SMTPPASS MANTISAPITOKEN' 10 | →0 11 | :EndIf 12 | 13 | (tn r)←OpenLogFile LOGFILE←DATABASE,'/SecurityIssueLog.dcf' 14 | →(0≠≢r)⍴0 15 | 16 | cols←'id' 'updated' 'status' 'reporter' 'summary' 17 | 18 | f←(⎕JSON MantisAPI'filters').filters.(id name) 19 | f←∊{(⍵∊'Security=Yes' 'Security "Not Sure"')/⍺}/↓⍉↑f ⍝ The filter ID 20 | 21 | ns←{⎕JSON MantisAPI 'issues?filter_id=',⍕⍵}¨f 22 | issues←⊃,/ns.issues 23 | new←↑issues.(id updated_at status.name reporter.name summary) ⍝ New Status 24 | new,←issues.(((custom_fields.(field.name))⍳⊂'Security Related')⊃custom_fields.value) 25 | ignore←⊂'Fixed In n/a => n/a' 26 | new,←{6↓∊'
'∘,¨ignore~⍨{⍵.message,' ',{0::'' ⋄ ⍵.change}⍵}¨⍵/⍨⍵.created_at∊((¯1↑⍵).created_at)}¨issues.history 27 | new,←↑issues.(created_at ({0::'' ⋄ handler.name}0)) 28 | new[;2 8]←ISOtoDN¨new[;2 8] ⍝ ISO timestamps to UTC IDN 29 | 30 | now←1 ⎕DT'Z' ⍝ Server time is UTC 31 | tsfmt←now∘TSFmtNice ⍝ Was 'Mmm DD hh:mm'∘(1200⌶) 32 | 33 | :If 11=2⊃⎕FSIZE tn ⍝ file with no data in it 34 | (now new)⎕FAPPEND tn 35 | :EndIf 36 | 37 | :If 2=⍴⍴old←⎕FREAD tn,cn←¯1+2⊃⎕FSIZE tn ⍝ if last comonent is a matrix 38 | then←2 1 ⎕DT 3⊃⎕FRDCI tn,cn ⍝ ... then get timestamp from component information 39 | :ElseIf 2=⍴old 40 | (then old)←old ⍝ ... else component should contain timestamp and data 41 | :Else 42 | msg←'Invalid file format' 43 | →SEND⊣fileok←0 44 | :EndIf 45 | fileok←1 46 | old,←((≢old),(2⊃⍴new)-2⊃⍴old)⍴⊂'' ⍝ Pad old result with new cols if necessary 47 | 48 | :Select interval 49 | :Case ¯1 ⍝ All open issues 50 | added←gone←0⌿new 51 | changed←(~new[;3]∊⊂'closed')⌿new 52 | subject←'List of All Open Security Issues' 53 | timestamp←0⍴⊂'' 54 | 55 | :Else ⍝ Changes since last run 56 | added←(~new[;1]∊old[;1])⌿new 57 | gone←(~old[;1]∊new[;1])⌿old ⍝ disappeared from the list 58 | changed←(~(new[;1]∊added[;1],gone[;1])∨(↓new[;1 3])∊↓old[;1 3])⌿new 59 | subject←'Recent changes' 60 | timestamp←⊂'List of changes since ',⊃tsfmt then 61 | :EndSelect 62 | 63 | :If 0≠≢tbl←⊃⍪/(⊂¨'*NEW*' ((interval≢¯1)/'Updated') 'Removed'),¨added changed gone 64 | 65 | out←tbl[ix←⍋tbl[;4]∊⊂'resolved';2 7 1 4 8 3 6] ⍝ Move resolved issues to the end 66 | 67 | nums←⍕¨out[;1] 68 | out←0 1↓out 69 | cols←'' '' 'Status' 'Last Change' 'Timestamp' 'Description' ⍝ 1st 2: Action & Not Sure 70 | out[;3]←(1 ⎕C 1↑¨out[;3]),¨1↓¨out[;3] ⍝ Capitalise Status 71 | out[;3]←out[;3] 72 | out[;4]←out[;4],¨'   
'∘,¨tsfmt out[;5] 73 | out[;5]←⊂'' 74 | out[;1]←tbl[ix;5],¨' ',¨(tsfmt tbl[ix;9]),¨('' '
*NOT SURE*')[1+out[;1]∊⊂'Not sure'] 75 | out[;1]←out[;1],¨{(×≢⍵)/'
Assigned ',⍵}¨tbl[ix;10] ⍝ Add Handler.name 76 | rows←''),¨nums,¨(⊂'') 77 | 78 | :If (n←≢out)>p←¯1+⊃out[;3]⍳⊂'Resolved' 79 | rows←(drop←2×p=0)↓(p↑rows),'' 'Resolved:',p↓rows 80 | out←drop↓(p 2 (n-p)/1 0 1)⍀out 81 | out[;5]←⊂'' 82 | :EndIf 83 | 84 | m←~∧⌿out∊⊂'' ⍝ mask out empty cols 85 | msg←∊HtmlTable rows (m/cols) ((⍕¨m/out),¨⊂'   ') 86 | :If interval=¯1 87 | size←⎕FSIZE tn 88 | msg,←'

Log file size is ',(2⍕1E6÷⍨3⊃size),'Mb (',(⍕--/2↑size),' components)' 89 | :EndIf 90 | :Else 91 | msg←'' 92 | :EndIf 93 | 94 | SEND: 95 | :If 0≠≢msg 96 | ⎕←'About to send Mantis security issues email to ',MAILTO 97 | SendMail MAILSERVER MAILFROM SMTPPASS MAILTO('SSGMon: ',subject)msg 98 | ⎕←'Sent Mantis security issues email: ' subject 99 | :Else 100 | ⎕←'No changes to Mantis security issues so not emailing ',MAILTO 101 | :EndIf 102 | 103 | :If fileok 104 | :AndIf old[;1 2]≢new[;1 2] ⍝ Something changed? 105 | (now new)⎕FAPPEND tn ⍝ Write a new record 106 | :EndIf 107 | ⎕FUNTIE tn 108 | -------------------------------------------------------------------------------- /ThirdPartyVulnerabilities.aplf: -------------------------------------------------------------------------------- 1 | r←ThirdPartyVulnerabilities interval;subject;m;list;msg;tsfmt;summary;http;tpf;targets;i;target;url;rc;last;newhash;changed;body;retried;max_tries;delay;config;cpes;urls;cpe;usecpe;lastfile;lastts;ns;cve;ts;dates;since;t;data;more;havelast;wait;out;daynos;startdate 2 | ⍝ Send SSGMon e-mail regarding 3rd party vulnerabilities 3 | ⍝ r is empty on success, else error message 4 | ⍝ if interval=¯1, report last changed date for all monitored URLs 5 | ⍝ if interval=0, any modified issues 6 | 7 | max_tries←10 ⍝ Maximum number of attempts on timeout 8 | delay←30 ⍝ Delay between tries 9 | wait←15 ⍝ Delay between targets to avoid NIST throttling 10 | startdate←1 ⎕DT ⊂2024 2 1 ⍝ Our first run 11 | 12 | r←'' 13 | subject←'Error' ⍝ If anything goes wrong en route 14 | :If ∨/m←0=≢¨MAILSERVER MAILFROM MAILTO SMTPPASS DATABASE 15 | r←'Missing configuration: ',⍕m/' '(=⊂⊢)' MAILSERVER MAILFROM MAILTO SMTPPASS DATABASE' 16 | →0 17 | :EndIf 18 | :If ~⎕NEXISTS MONITORCFG 19 | r←'Cannot find monitor configuration file "',MONITORCFG,'"' 20 | →0 21 | :EndIf 22 | tpf←⎕CSV MONITORCFG 23 | (targets cpes urls)←↓⍉{⍵[⍋⎕C ⍵[;1];]}1↓tpf[;(⎕C tpf[1;])⍳'component' 'cpe' 'url'] 24 | msg←list←'' 25 | tsfmt←TSFmtNice ⍝ Was 'Mmm DD hh:mm'∘(1200⌶) 26 | summary←interval=¯1 27 | 28 | ⍝ Initalize HttpCommand used in Watch 29 | http←⎕NEW #.HttpCommand 30 | http.URL←'' 31 | http.Command←'get' 32 | http.Timeout←30000 ⍝ (HttpCommand default is 5000) 33 | 34 | out←0 5⍴⊂'' ⍝ ts target type lastupdate link 35 | 36 | :For (target cpe url) :InEach targets cpes urls 37 | :If usecpe←0≠≢cpe 38 | http.URL←url←'https://services.nvd.nist.gov/rest/json/cves/2.0?cpeName=cpe:2.3:',cpe,14⍴':*' 39 | :Else 40 | http.URL←'https://',url 41 | :EndIf 42 | 43 | retried←0 44 | RETRY: 45 | rc←http.Run 46 | 47 | :If rc.rc=0 48 | :AndIf rc.HttpStatus=200 49 | :If ⎕NEXISTS lastfile←DATABASE,'/',target,'.last.',(1+usecpe)⊃'html' 'json' 50 | last←⊃⎕NGET lastfile 51 | lastts←⊃¯1 ⎕DT ts←⊃13 ⎕NINFO lastfile 52 | :Else 53 | (last lastts)←''(7⍴0) 54 | :EndIf 55 | 56 | :If havelast←lastts∨.≠0 57 | since←tsfmt 1 ⎕DT⊂lastts 58 | :Else 59 | since←'(no previous run found)' 60 | :EndIf 61 | 62 | :If usecpe 63 | ⎕DL wait ⍝ Avoid NIST throttling 64 | ns←0 ⎕JSON data←rc.Data 65 | :If 0≠ns.totalResults 66 | cve←{⍵[⍒⍵;]}↑(ns.vulnerabilities).cve.(lastModified id(⊃descriptions).value) 67 | more←3<≢cve 68 | cve←(3⌊≢cve)↑cve 69 | cve[;3]←{(1⍳⍨'. '⍷⍵)↑⍵}¨cve[;3] 70 | cve[;2]←{'',⍵,''}¨cve[;2] 71 | ts←2⊃⎕VFI,' ',(↑cve[;1])[;1 2 3 4 6 7 9 10 12 13 15 16 18 19] 72 | dates←tsfmt daynos←1 ⎕DT↓⍉((10000,5⍴100)⊤ts)⍪0 73 | :Else 74 | cve←0 3⍴⊂'' ⋄ ts←dates←⍬ 75 | :EndIf 76 | :If changed←∨/m←ts>100⊥¯1↓lastts 77 | (ts cve dates)←m∘⌿¨ts cve dates 78 | t←'

',target,': ',(more/'last 3 '),' updates ',(havelast/'since '),since 79 | msg,←(⊂t),'
'∘,¨↓⍕dates,0 1↓cve 80 | :EndIf 81 | :If summary 82 | :If 0=≢cve 83 | out⍪←0 target 'CPE' '-' ('NIST query') 84 | :Else 85 | out⍪←(⊃daynos) target 'CPE' (⊃dates) (⊃cve[;2]) 86 | :EndIf 87 | :EndIf 88 | 89 | :Else ⍝ No CPE, using a URL - assume it is a GitHub advisory page 90 | url←'',url,'' 91 | body←⊃(''⎕S'\1'⎕OPT('Mode' 'M')('DotAll' 1))⊢rc.Data 92 | :If 0=≢t←(¯1+1⍳⍨'
'⍷body)↓body 93 | msg,←target,': Unable to find advisories div in ',url 94 | :Else 95 | data←t↑⍨5+0⍳⍨+\('
',target,': ',(havelast/'Changed: '),url,' ',(havelast/', Last update '),since 99 | :EndIf 100 | :If summary ⍝ produce list 101 | :If ~havelast ⋄ ∘∘∘ ⋄ :EndIf 102 | :If startdate>⊃ts ⋄ (since ts)←'-' 0 ⋄ :EndIf 103 | out⍪←(⊃ts) target 'URL' since url 104 | :EndIf 105 | :EndIf 106 | :EndIf 107 | 108 | :If changed 109 | (⊂data)⎕NPUT lastfile 1 110 | :EndIf 111 | 112 | :ElseIf (rc.rc=100)∨rc.HttpStatus=403 ⍝ Timeout / Unavailable 113 | retried+←1 114 | ⎕←'Retrying (',(⍕rc.(rc HttpStatus)),'): ',url 115 | :If retried
',target,': UNABLE to check ',url,': ',(⍕rc.(rc HttpStatus)),'
' 121 | :EndIf 122 | :EndFor 123 | 124 | subject←'Third Party Vulnerability Update',summary/' - With Overview' 125 | 126 | :If summary 127 | out←out[⍋out[;2];] ⍝ Ascending by title 128 | out←out[⍒out[;1];4 2 3 5] ⍝ Sort by last date descending 129 | list←(⊂'OVERVIEW

'),HtmlTable '' ('Last Update' 'Component' 'Type' 'Link') out 130 | msg←list,(1+0≠≢msg)⊃'
(No recent updates)' ('
RECENT UPDATES',msg) 131 | ⎕←'Checked 3rd party vulnerability URLS' 132 | :EndIf 133 | 134 | 135 | SEND: 136 | :If 0≠≢msg 137 | ⎕←'About to send 3rd party vulnerablility check list to ',MAILTO 138 | SendMail MAILSERVER MAILFROM SMTPPASS MAILTO('SSGMon: ',subject)msg 139 | ⎕←'Sent 3rd party vulnerablility check list:'subject 140 | :Else 141 | ⎕←'No new 3rd party vulnerabilities to send to ',MAILTO 142 | :EndIf 143 | -------------------------------------------------------------------------------- /HttpCommand.aplc: -------------------------------------------------------------------------------- 1 | :Class HttpCommand 2 | ⍝ General HTTP Commmand utility 3 | ⍝ Documentation is found at https://dyalog.github.io/HttpCommand/ 4 | 5 | ⎕ML←⎕IO←1 6 | 7 | ∇ r←Version 8 | ⍝ Return the current version 9 | :Access public shared 10 | r←'HttpCommand' '5.4.4' '2023-10-31' 11 | ∇ 12 | 13 | ⍝ Request-related fields 14 | :field public Command←'get' ⍝ HTTP command (method) 15 | :field public URL←'' ⍝ requested resource 16 | :field public Params←'' ⍝ request parameters 17 | :field public Headers←0 2⍴⊂'' ⍝ request headers - name, value 18 | :field public ContentType←'' ⍝ request content-type 19 | :field public Cookies←⍬ ⍝ request cookies - vector of namespaces 20 | :field public Auth←'' ⍝ authentication string 21 | :field public AuthType←'' ⍝ authentication type 22 | :field public BaseURL←'' ⍝ base URL to use when making multiple requests to the same host 23 | 24 | ⍝ Proxy-related fields - only used if connecting through a proxy server 25 | :field public ProxyURL←'' ⍝ address of the proxy server 26 | :field public ProxyAuth←'' ⍝ authentication string, if any, for the proxy server 27 | :field public ProxyAuthType←'' ⍝ authentication type, if any, for the proxy server 28 | :field public ProxyHeaders←0 2⍴⊂'' ⍝ any headers that the proxy server might need 29 | 30 | ⍝ Conga-related fields 31 | :field public BufferSize←200000 ⍝ Conga buffersize 32 | :field public WaitTime←5000 ⍝ Timeout in ms on Conga Wait call 33 | :field public Cert←⍬ ⍝ X509 instance if using HTTPS 34 | :field public SSLFlags←32 ⍝ SSL/TLS flags - 32 = accept cert without checking it 35 | :field public Priority←'NORMAL:!CTYPE-OPENPGP' ⍝ GnuTLS priority string 36 | :field public PublicCertFile←'' ⍝ if not using an X509 instance, this is the client public certificate file 37 | :field public PrivateKeyFile←'' ⍝ if not using an X509 instance, this is the client private key file 38 | :field public shared LDRC ⍝ HttpCommand-set reference to Conga after CongaRef has been resolved 39 | :field public shared CongaPath←'' ⍝ path to user-supplied conga workspace (assumes shared libraries are in the same path) 40 | :field public shared CongaRef←'' ⍝ user-supplied reference to Conga library 41 | :field public shared CongaVersion←'' ⍝ Conga [major minor build] 42 | 43 | ⍝ Operational fields 44 | :field public SuppressHeaders←0 ⍝ set to 1 to suppress HttpCommand-supplied default request headers 45 | :field public MaxPayloadSize←¯1 ⍝ set to ≥0 to take effect 46 | :field public Timeout←10 ⍝ seconds to wait for a response before timing out, negative means reset timeout if any activity 47 | :field public RequestOnly←¯1 ⍝ set to 1 if you only want to return the generated HTTP request, but not actually send it 48 | :field public OutFile←'' ⍝ name of file to send payload to (format is same as ⎕NPUT right argument) 49 | :field public MaxRedirections←10 ⍝ set to 0 if you don't want to follow any redirected references, ¯1 for unlimited 50 | :field public KeepAlive←1 ⍝ default to not close client connection 51 | :field public TranslateData←0 ⍝ set to 1 to translate XML or JSON response data 52 | :field public UseZip←0 ⍝ zip request payload (0-no, 1-use gzip, 2-use deflate) 53 | :field public ZipLevel←1 ⍝ default compression level (0-9) 54 | :field public shared Debug←0 ⍝ set to 1 to disable trapping, 2 to stop just before creating client 55 | 56 | :field public readonly shared ValidFormUrlEncodedChars←'&=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-._~*+~%' 57 | 58 | :field Client←'' ⍝ Conga client ID 59 | :field ConxProps←'' ⍝ when a client is made, its connection properties are saved so that if either changes, we close the previous client 60 | :field origCert←¯1 ⍝ used to check if Cert changed between calls 61 | 62 | ∇ make 63 | ⍝ No argument constructor 64 | :Access public 65 | :Implements constructor 66 | ∇ 67 | 68 | ∇ make1 args;settings;invalid 69 | ⍝ Constructor arguments - [Command URL Params Headers Cert SSLFlags Priority] 70 | :Access public 71 | :Implements constructor 72 | →0⍴⍨0∊⍴args 73 | args←(eis⍣({9.1≠⎕NC⊂,'⍵'}⊃args)⊢args) 74 | :Select {⊃⎕NC⊂,'⍵'}⊃args 75 | :Case 2.1 ⍝ array 76 | Command URL Params Headers Cert SSLFlags Priority←7↑args,(⍴args)↓Command URL Params Headers Cert SSLFlags Priority 77 | :Case 9.1 ⍝ namespace 78 | :If 0∊⍴invalid←(settings←args.⎕NL ¯2.1 ¯9.1)~(⎕NEW⊃⊃⎕CLASS ⎕THIS).⎕NL ¯2.2 79 | args{⍎⍵,'←⍺⍎⍵'}¨settings 80 | :Else ⋄ ('Invalid HttpCommand setting(s): ',,⍕invalid)⎕SIGNAL 11 81 | :EndIf 82 | :Else ⋄ 'Invalid constructor argument'⎕SIGNAL 11 83 | :EndSelect 84 | ∇ 85 | 86 | ∇ {ns}←initResult ns 87 | ⍝ initialize the namespace result 88 | :Access shared 89 | ns.(Command URL rc msg HttpVersion HttpStatus HttpMessage Headers Data PeerCert Redirections Cookies OutFile Elapsed BytesWritten)←'' '' ¯1 '' ''⍬''(0 2⍴⊂'')''⍬(0⍴⊂'')⍬'' 0 ¯1 90 | ns.GetHeader←{⎕IO←⎕ML←1 ⋄ ⍺←Headers ⋄ ⍺{1<|≡⍵:⍺∘∇¨⍵ ⋄ (⍺[;2],⊂'')⊃⍨⍺[;1](⍳{(⍵⍵ ⍺)⍺⍺(⍵⍵ ⍵)}{2::0(819⌶)⍵ ⋄ ¯3 ⎕C ⍵})⊆,⍵}⍵} ⍝ return header value or '' if not found 91 | ns.⎕FX'∇r←IsOK' 'r←0 2≡rc,⌊.01×HttpStatus' '∇' 92 | ∇ 93 | 94 | ∇ Goodbye 95 | :Implements destructor 96 | {}{0::'' ⋄ LDRC.Names'.'⊣LDRC.Close ⍵}⍣(~0∊⍴Client)⊢Client 97 | ∇ 98 | 99 | ∇ r←Config 100 | ⍝ Returns current configuration 101 | :Access public 102 | r←↑{6::⍵'not set' ⋄ ⍵(⍎⍵)}¨(⎕THIS⍎'⎕NL ¯2.2')~⊂'ValidFormUrlEncodedChars' 103 | ∇ 104 | 105 | ∇ r←Run 106 | ⍝ Attempt to run the HTTP command 107 | :Access public 108 | RequestOnly←0⌈RequestOnly 109 | Result←initResult #.⎕NS'' 110 | :Trap Debug↓0 111 | r←(Cert SSLFlags Priority PublicCertFile PrivateKeyFile)HttpCmd Command URL Params Headers 112 | :Else ⍝ :Trap 113 | r←Result 114 | r.(rc msg)←¯1('Unexpected ',⊃{⍺,' at ',⍵}/2↑⎕DMX.DM) 115 | :EndTrap 116 | setDisplayFormat r 117 | exit: 118 | ∇ 119 | 120 | ∇ r←Show;ro 121 | ⍝ Show the request to be sent to the server 122 | :Access public 123 | ro←RequestOnly 124 | RequestOnly←1 125 | r←Run 126 | RequestOnly←ro 127 | ∇ 128 | 129 | ∇ {r}←setDisplayFormat r;rc;msg;stat;data 130 | ⍝ set the display format for the namespace result for most HttpCommand commands 131 | :If 9.1=nameClass r 132 | rc←'rc: ',⍕r.rc 133 | msg←' | msg: ',⍕r.msg 134 | stat←' | HTTP Status: ',(⍕r.HttpStatus),' "',r.HttpMessage,'"' 135 | data←' | ',{¯1≠r.BytesWritten:(⍕r.BytesWritten),' bytes written to ',r.OutFile ⋄ '≢Data: ',(⍕≢⍵),(9.1=nameClass ⍵)/' (namespace)'}r.Data 136 | r.⎕DF 1⌽'][',rc,msg,stat,data 137 | :EndIf 138 | ∇ 139 | 140 | ∇ r←{requestOnly}Get args 141 | ⍝ Shared method to perform an HTTP GET request 142 | ⍝ args - [URL Params Headers Cert SSLFlags Priority] 143 | :Access public shared 144 | :If 0=⎕NC'requestOnly' ⋄ requestOnly←¯1 ⋄ :EndIf 145 | :If 2.1=nameClass⊃args ⋄ args←((⊂'GET'),eis args) ⋄ :EndIf 146 | →∆EXIT⍴⍨9.1=nameClass r←requestOnly New args 147 | r←r.Run 148 | ∆EXIT: 149 | ∇ 150 | 151 | ∇ r←{requestOnly}Do args 152 | ⍝ Shared method to perform any HTTP request 153 | ⍝ args - [Command URL Params Headers Cert SSLFlags Priority] 154 | :Access public shared 155 | :If 0=⎕NC'requestOnly' ⋄ requestOnly←¯1 ⋄ :EndIf 156 | →∆EXIT⍴⍨9.1=nameClass r←requestOnly New args 157 | r←r.Run 158 | ∆EXIT: 159 | ∇ 160 | 161 | ∇ r←{requestOnly}New args 162 | ⍝ Shared method to create new HttpCommand 163 | ⍝ args - [Command URL Params Headers Cert SSLFlags Priority] 164 | ⍝ requestOnly - initial setting for RequestOnly 165 | :Access public shared 166 | :If 0=⎕NC'requestOnly' ⋄ requestOnly←¯1 ⋄ :EndIf 167 | r←'' 168 | :Trap Debug↓0 169 | :If 0∊⍴args 170 | r←##.⎕NEW ⎕THIS 171 | :Else 172 | r←##.⎕NEW ⎕THIS(eis⍣(9.1≠nameClass⊃args)⊢args) 173 | :EndIf 174 | r.RequestOnly←requestOnly 175 | :Else 176 | r←initResult #.⎕NS'' 177 | r.(rc msg)←¯1 ⎕DMX.EM 178 | setDisplayFormat r 179 | →∆EXIT 180 | :EndTrap 181 | ∆EXIT: 182 | ∇ 183 | 184 | ∇ r←{requestOnly}GetJSON args;cmd 185 | ⍝ Shared method to perform an HTTP request with JSON data as the request and response payloads 186 | ⍝ args - [Command URL Params Headers Cert SSLFlags Priority] 187 | :Access public shared 188 | :If 0=⎕NC'requestOnly' ⋄ requestOnly←¯1 ⋄ :EndIf 189 | 190 | →∆EXIT⍴⍨9.1=nameClass cmd←requestOnly New args 191 | :If 0∊⍴cmd.Command ⋄ cmd.Command←(1+0∊⍴cmd.Params)⊃'POST' 'GET' ⋄ :EndIf 192 | :If ~(⊂lc cmd.Command)∊'get' 'head' 193 | :If 0∊⍴cmd.ContentType ⋄ cmd.ContentType←'application/json;charset=utf-8' ⋄ :EndIf 194 | :If ~0∊⍴cmd.Params 195 | :Trap Debug↓0 196 | cmd.Params←JSONexport cmd.Params 197 | :Else 198 | →∆DONE⊣r.(rc msg)←¯1 'Could not convert parameters to JSON format' 199 | :EndTrap 200 | :EndIf 201 | :EndIf 202 | r←cmd.Run 203 | →cmd.RequestOnly⍴∆EXIT 204 | 205 | :If r.rc=0 206 | →∆DONE⍴⍨204=r.HttpStatus ⍝ exit if "no content" HTTP status 207 | :If ¯1=r.BytesWritten ⍝ if not writing to file 208 | :If ∨/'application/json'⍷lc r.Headers getHeader'content-type' 209 | JSONimport r 210 | :Else ⋄ →∆DONE⊣r.(rc msg)←¯2 'Response content-type is not application/json' 211 | :EndIf 212 | :EndIf 213 | :EndIf 214 | ∆DONE: ⍝ reset ⎕DF if messages have changed 215 | setDisplayFormat r 216 | ∆EXIT: 217 | ∇ 218 | 219 | ∇ r←{ro}Fix args;z;url;target 220 | ⍝ retrieve and fix APL code loads the latest version from GitHub 221 | ⍝ args is: 222 | ⍝ [1] URL of code to fix - if the URL has 'github' (but not 'raw.githubusercontent.com') in it, we do some gratuitous massaging 223 | ⍝ [2] (optional) reference to namespace in which to fix the code (default ##) 224 | ⍝ example: HttpCommand.Fix 'github/Dyalog/Jarvis/Source/Jarvis.dyalog' #. 225 | :Access public shared 226 | (url target)←2↑(,⊆args),## 227 | :If 0=⎕NC'ro' ⋄ ro←0 ⋄ :EndIf 228 | r←z←ro Get{ ⍝ convert url if necessary 229 | ~∨/'github'⍷⍵:⍵ ⍝ if not github just 230 | ∨/'raw.githubusercontent.com'⍷⍵:⍵ ⍝ already refers to 231 | t←'/'(≠⊆⊢)⍵ 232 | i←⍸<\∨/¨'github'∘⍷¨t 233 | 'https://raw.githubusercontent.com',∊'/',¨(2↑i↓t),(⊂'master'),(2+i)↓t 234 | }url 235 | →ro⍴0 236 | :If z.rc≠0 237 | r←z.(rc msg) 238 | :ElseIf z.HttpStatus≠200 239 | r←¯1(⍕z) 240 | :Else 241 | :Trap 0 242 | r←0(⍕target{0::⍺.⎕FX ⍵ ⋄ ⍺.⎕FIX ⍵}{⍵⊆⍨~⍵∊⎕UCS 13 10 65279}z.Data) 243 | :Else 244 | r←¯1('Could not ⎕FIX file: ',2↓∊': '∘,¨⎕DMX.(EM Message)) 245 | :EndTrap 246 | :EndIf 247 | ∇ 248 | 249 | ∇ r←Init 250 | :Access Public 251 | r←(Initialize initResult ⎕NS'').(rc msg) 252 | r[1]×←~0∊⍴2⊃r ⍝ set to 0 if no error message from Conga initialization 253 | ∇ 254 | 255 | ∇ r←Initialize r;ref;root;nc;n;ns;congaCopied;class;path 256 | ⍝↓↓↓ Check if LDRC exists (VALUE ERROR (6) if not), and is LDRC initialized? (NONCE ERROR (16) if not) 257 | r.msg←'' 258 | :Hold 'HttpCommandInit' 259 | :If {6 16 999::1 ⋄ ''≡LDRC:1 ⋄ 0⊣LDRC.Describe'.'}'' 260 | LDRC←'' 261 | :If ~0∊⍴CongaRef ⍝ did the user supply a reference to Conga? 262 | :If 0∊⍴LDRC←r ResolveCongaRef CongaRef 263 | r.msg,⍨←'Could not initialize Conga using CongaRef "',(⍕CongaRef),'" due to ' 264 | →∆END 265 | :EndIf 266 | :Else 267 | :For root :In ## # 268 | ref nc←root{1↑¨⍵{(×⍵)∘/¨⍺ ⍵}⍺.⎕NC ⍵}ns←'Conga' 'DRC' 269 | :If 9=⊃⌊nc ⋄ :Leave ⋄ :EndIf 270 | :EndFor 271 | 272 | :If 9=⊃⌊nc 273 | :If 0∊⍴LDRC←r ResolveCongaRef(root⍎∊ref) 274 | →∆END⊣r.msg,⍨←'Could not initialize Conga from "',(∊(⍕root)'.'ref),'" due to ' 275 | :EndIf 276 | →∆COPY↓⍨{999::0 ⋄ 1⊣LDRC.Describe'.'}'' ⍝ it's possible that Conga was saved in a semi-initialized state 277 | :Else 278 | ∆COPY: 279 | class←⊃⊃⎕CLASS ⎕THIS 280 | :If ~0∊⍴CongaPath 281 | CongaPath←∊1 ⎕NPARTS CongaPath,'/' 282 | →∆END↓⍨0∊⍴r.msg←(~⎕NEXISTS CongaPath)/'CongaPath "',CongaPath,'" does not exist' 283 | →∆END↓⍨0∊⍴r.msg←(1≠1 ⎕NINFO CongaPath)/'CongaPath "',CongaPath,'" is not a folder' 284 | :EndIf 285 | congaCopied←0 286 | :For n :In ns 287 | :For path :In (1+0∊⍴CongaPath)⊃(⊂CongaPath)((dyalogRoot,'ws/')'') ⍝ if CongaPath specifiec, use it exclusively 288 | :Trap Debug↓0 289 | n class.⎕CY path,'conga' 290 | LDRC←r ResolveCongaRef(class⍎n) 291 | :If 0∊⍴LDRC 292 | r.msg,⍨←n,' was copied from "',path,'conga", but encountered ' 293 | →∆END 294 | :EndIf 295 | →∆COPIED⊣congaCopied←1 296 | :EndTrap 297 | :EndFor 298 | :EndFor 299 | →∆END↓⍨0∊⍴r.msg←(~congaCopied)/'neither Conga nor DRC were successfully copied' 300 | ∆COPIED: 301 | :EndIf 302 | :EndIf 303 | :EndIf 304 | CongaVersion←LDRC.Version 305 | LDRC.X509Cert.LDRC←LDRC ⍝ reset X509Cert.LDRC reference 306 | :If 0≠⊃LDRC.SetProp'.' 'EventMode' 1 307 | r.msg←'Unable to set EventMode on Conga root' 308 | :EndIf 309 | ∆END: 310 | :EndHold 311 | ∇ 312 | 313 | ∇ LDRC←r ResolveCongaRef CongaRef;failed;z 314 | ⍝ Attempt to resolve what CongaRef refers to 315 | ⍝ CongaRef can be a charvec, reference to the Conga or DRC namespaces, or reference to an iConga instance 316 | ⍝ LDRC is '' if Conga could not be initialized, otherwise it's a reference to the the Conga.LIB instance or the DRC namespace 317 | 318 | LDRC←'' ⋄ failed←0 319 | :Select nameClass CongaRef ⍝ what is it? 320 | :Case 9.1 ⍝ namespace? e.g. CongaRef←DRC or Conga 321 | ∆TRY: 322 | :Trap Debug↓0 323 | :If 2 3≢⌊CongaRef.⎕NC'DllVer' 'Init' 324 | r.msg←'it does not refer to a valid Conga interface' 325 | →∆EXIT⊣LDRC←'' 326 | :EndIf 327 | :If ∨/'.Conga'⍷⍕CongaRef ⍝ Conga? 328 | LDRC←CongaPath CongaRef.Init'HttpCommand' 329 | :ElseIf 0≡⊃CongaRef.Init CongaPath ⍝ DRC? 330 | LDRC←CongaRef 331 | :Else ⍝ should never get to here, but... (paranoia) 332 | r.msg←'it does not refer to a valid Conga interface' 333 | →∆EXIT⊣LDRC←'' 334 | :End 335 | :Else ⍝ if HttpCommand is reloaded and re-executed in rapid succession, Conga initialization may fail, so we try twice 336 | :If failed 337 | →∆EXIT⊣LDRC←''⊣r.msg←∊{⍺,(~0∊⍴⍵)/': ',⍵}/⎕DMX.(EM Message) 338 | :Else 339 | →∆TRY⊣failed←1 340 | :EndIf 341 | :EndTrap 342 | :Case 9.2 ⍝ instance? e.g. CongaRef←Conga.Init '' 343 | :If 3=⌊|CongaRef.⎕NC⊂'Clt' ⍝ if it looks like a valid Conga reference 344 | LDRC←CongaRef ⍝ an instance is already initialized 345 | :EndIf 346 | :Case 2.1 ⍝ variable? e.g. CongaRef←'#.Conga' 347 | :Trap Debug↓0 348 | :If 9≠z←⎕NC⍕CongaRef 349 | →∆EXIT⊣r.msg←'CongaRef ',(1+z=0)⊃'is invalid' 'was not found' 350 | :EndIf 351 | LDRC←r ResolveCongaRef(⍎∊⍕CongaRef) 352 | :Else 353 | r.msg←∊{⍺,(~0∊⍴⍵)/': ',⍵}/⎕DMX.(EM Message) 354 | :EndTrap 355 | :EndSelect 356 | ∆EXIT: 357 | ∇ 358 | 359 | ∇ (rc secureParams)←CreateSecureParams certs;cert;flags;priority;public;private;nmt;msg;t 360 | ⍝ certs is: 361 | ⍝ cert - X509Cert instance or (PublicCertFile PrivateKeyFile) 362 | ⍝ flags - SSL flags 363 | ⍝ priority - GnuTLS priority 364 | ⍝ public - PublicCertFile 365 | ⍝ private - PrivateKeyFile 366 | 367 | certs←,⊆certs 368 | (cert flags priority public private)←5↑certs,(≢certs)↓'' 0 'NORMAL:!CTYPE-OPENPGP' '' '' 369 | 370 | LDRC.X509Cert.LDRC←LDRC ⍝ make sure the X509 instance points to the right LDRC 371 | 372 | :If 0∊⍴cert ⍝ if X509 (or public private) not supplied 373 | ∆CHECK: 374 | ⍝ if cert is empty, check PublicCertFile and PrivateKeyFile 375 | :If ∨/nmt←(~0∊⍴)¨public private ⍝ either file name not empty? 376 | :If ∧/nmt ⍝ if so, both need to be non-empty 377 | :If ∨/t←{0::1 ⋄ ~⎕NEXISTS ⍵}¨public private ⍝ either file not exist? 378 | →∆FAIL⊣msg←'Not found',4↓∊t/'PublicCertFile' 'PrivateKeyFile'{' and ',⍺,' "',(∊⍕⍵),'"'}¨public private 379 | :EndIf 380 | :Trap Debug↓0 381 | cert←⊃LDRC.X509Cert.ReadCertFromFile public 382 | :Else 383 | →∆FAIL⊣msg←'Unable to decode PublicCertFile "',(∊⍕public),'" as certificate' 384 | :EndTrap 385 | cert.KeyOrigin←'DER'private 386 | :Else 387 | →∆FAIL⊣msg←(⊃nmt/'PublicCertFile' 'PrivateKeyFile'),' is empty' ⍝ both must be specified 388 | :EndIf 389 | :Else 390 | cert←⎕NEW LDRC.X509Cert 391 | :EndIf 392 | :ElseIf 2=⍴cert ⍝ 2-element vector of public/private file names? 393 | public private←cert 394 | →∆CHECK 395 | :ElseIf {0::1 ⋄ 'X509Cert'≢{⊃⊢/'.'(≠⊆⊢)⍵}⍕⎕CLASS ⍵}cert 396 | →∆FAIL⊣msg←'Invalid certificate parameter' 397 | :EndIf 398 | secureParams←('x509'cert)('SSLValidation'flags)('Priority'priority) 399 | →rc←0 400 | ∆FAIL:(rc secureParams)←¯1 msg ⍝ failure 401 | ∇ 402 | 403 | ∇ {r}←certs HttpCmd args;url;parms;hdrs;urlparms;p;b;secure;port;host;path;auth;req;err;done;data;datalen;rc;donetime;ind;len;obj;evt;dat;z;msg;timedOut;certfile;keyfile;simpleChar;defaultPort;cookies;domain;t;replace;outFile;toFile;startSize;options;congaPath;progress;starttime;outTn;secureParams;ct;forceClose;headers;cmd;file;protocol;conx;proxied;proxy;cert;noCT;simpleParms;noContentLength;connectionClose;tmpFile;tmpTn;redirected;encoding;compType;isutf8 404 | ⍝ issue an HTTP command 405 | ⍝ certs - X509Cert|(PublicCertFile PrivateKeyFile) SSLValidation Priority PublicCertFile PrivateKeyFile 406 | ⍝ args - [1] HTTP method 407 | ⍝ [2] URL in format [HTTP[S]://][user:pass@]url[:port][/path[?query_string]] 408 | ⍝ {3} parameters is using POST - either a namespace or URL-encoded string 409 | ⍝ {4} HTTP headers in form {↑}(('hdr1' 'val1')('hdr2' 'val2')) 410 | ⍝ {5} cookies in form {↑}(('cookie1' 'val1')('cookie2' 'val2')) 411 | ⍝ Makes secure connection if left arg provided or URL begins with https: 412 | 413 | ⍝ Result: namespace containing (conga return code) (HTTP Status) (HTTP headers) (HTTP body) [PeerCert if secure] 414 | args←,⊆args 415 | (cmd url parms headers cookies)←args,(⍴args)↓'' ''(⎕NS'')'' '' 416 | 417 | :If 0∊⍴cmd ⋄ cmd←'GET' ⋄ :EndIf 418 | 419 | r←Result 420 | toFile←redirected←outTn←tmpTn←0 ⍝ initial settings 421 | tmpFile←'' 422 | 423 | ⍝ Do some cursory parameter checking 424 | →∆END↓⍨0∊⍴r.msg←'No URL specified'/⍨0∊⍴url ⍝ exit early if no URL 425 | →∆END↓⍨0∊⍴r.msg←'URL is not a simple character vector'/⍨~isSimpleChar url 426 | →∆END↓⍨0∊⍴r.msg←'Cookies are not character'/⍨(0∊⍴cookies)⍱1↑isChar cookies 427 | →∆END↓⍨0∊⍴r.msg←'Headers are not character'/⍨(0∊⍴headers)⍱1↑isChar headers 428 | 429 | :If ~RequestOnly ⍝ don't bother initializing Conga if only returning request 430 | →∆END↓⍨0∊⍴(Initialize r).msg 431 | :EndIf 432 | 433 | url←,url 434 | url←BaseURL makeURL url 435 | cmd←uc,cmd 436 | 437 | ∆GET: 438 | 439 | ⍝ do header initialization here because we may return here on a redirect 440 | :Trap 7 441 | hdrs←makeHeaders headers 442 | :Else 443 | →∆END⊣r.msg←'Improper header format' 444 | :EndTrap 445 | 446 | conx←ConxProps ConnectionProperties r.URL←url 447 | →∆END↓⍨0∊⍴r.msg←conx.msg 448 | (protocol secure auth host port path urlparms defaultPort)←conx.(protocol secure auth host port path urlparms defaultPort) 449 | secure∨←⍲/{0∊⍴⍵}¨certs[1 4] ⍝ we're also secure if we have a cert or a PublicCertFile 450 | 451 | :If proxied←~0∊⍴ProxyURL 452 | :If CongaVersion(~atLeast)3 4 1626 ⍝ Conga build that introduced proxy support 453 | →∆END⊣r.msg←'Conga version 3.4.1626 or later is required to use a proxy' 454 | :EndIf 455 | proxy←ConnectionProperties ProxyURL 456 | →∆END↓⍨0∊⍴r.msg←proxy.msg 457 | proxy.headers←makeHeaders ProxyHeaders 458 | :EndIf 459 | 460 | r.(Secure Host Port Path)←secure(lc host)port({{'/',¯1↓⍵/⍨⌽∨\'/'=⌽⍵}⍵↓⍨'/'=⊃⍵}path) 461 | 462 | :If ~SuppressHeaders 463 | hdrs←'Host'(hdrs addHeader)host,((~defaultPort)/':',⍕port) 464 | hdrs←'User-Agent'(hdrs addHeader)deb'Dyalog-',1↓∊'/',¨2↑Version 465 | hdrs←'Accept'(hdrs addHeader)'*/*' 466 | hdrs←'Accept-Encoding'(hdrs addHeader)'gzip, deflate' 467 | :If ~0∊⍴Auth 468 | :If (1<|≡Auth)∨':'∊Auth ⍝ (userid password) or userid:password 469 | :AndIf ('basic'≡lc AuthType)∨0∊⍴AuthType 470 | Auth←Base64Encode ¯1↓∊(,⊆Auth),¨':' 471 | AuthType←'Basic' 472 | :EndIf 473 | hdrs←'Authorization'(hdrs setHeader)deb AuthType,' ',⍕Auth 474 | :EndIf 475 | :If '∘???∘'≡hdrs getHeader'cookie' ⍝ if the user has specified a cookie header, it takes precedence 476 | :AndIf ~0∊⍴cookies←r applyCookies Cookies 477 | hdrs←'Cookie'(hdrs addHeader)formatCookies cookies 478 | :EndIf 479 | :If ~0∊⍴auth 480 | hdrs←'Authorization'(hdrs addHeader)auth 481 | :EndIf 482 | :If proxied 483 | :If ~0∊⍴ProxyAuth 484 | :If (1<|≡ProxyAuth)∨':'∊ProxyAuth ⍝ (userid password) or userid:password 485 | :AndIf ('basic'≡lc ProxyAuthType)∨0∊⍴ProxyAuthType 486 | ProxyAuth←Base64Encode ¯1↓∊(,⊆ProxyAuth),¨':' 487 | ProxyAuthType←'Basic' 488 | :EndIf 489 | proxy.headers←'Proxy-Authorization'(proxy.headers setHeader)deb ProxyAuthType,' ',⍕ProxyAuth 490 | :EndIf 491 | :If ~0∊⍴proxy.auth 492 | proxy.headers←'Proxy-Authorization'(proxy.headers addHeader)proxy.auth 493 | :EndIf 494 | :EndIf 495 | :EndIf 496 | 497 | noCT←(0∊⍴ContentType)∧('∘???∘'≡hdrs getHeader'content-type') ⍝ no content-type specified 498 | :If noCT⍲0∊⍴parms ⍝ do we have any parameters or a content-type 499 | simpleParms←{2≠⎕NC'⍵':0 ⋄ 1≥|≡⍵}parms ⍝ simple vector or scalar and not a reference 500 | 501 | :If (⊆cmd)∊'GET' 'HEAD' ⍝ if the command is GET or HEAD 502 | :AndIf noCT 503 | ⍝ params needs to be URLEncoded and will be appended to the query string 504 | :If simpleParms 505 | parms←∊⍕parms ⍝ deal with possible numeric 506 | parms←UrlEncode⍣(~∧/parms∊HttpCommand.ValidFormUrlEncodedChars)⊢parms ⍝ URLEncode if necessary 507 | :Else ⍝ parms is a namespace or a name/value pairs array 508 | parms←UrlEncode parms 509 | :EndIf 510 | 511 | urlparms,←(0∊⍴urlparms)↓'&',parms 512 | parms←'' 513 | 514 | :Else ⍝ not a GET or HEAD command or content-type has been specified 515 | :If ~SuppressHeaders 516 | :If noCT ⍝ no content-type specified, try to work out what it should be 517 | :If simpleParms ⍝ if parms is simple 518 | :If (isJSON parms)∨isNum parms ⍝ and looks like JSON or is numeric 519 | hdrs←'Content-Type'(hdrs addHeader)'application/json;charset=utf-8' 520 | :Else 521 | hdrs←'Content-Type'(hdrs addHeader)'application/x-www-form-urlencoded' 522 | :EndIf 523 | :Else ⍝ not simpleParms 524 | hdrs←'Content-Type'(hdrs addHeader)'application/json;charset=utf-8' 525 | :EndIf 526 | :ElseIf ~0∊⍴ContentType ⍝ ContentType has been specified 527 | hdrs←'Content-Type'(hdrs setHeader)ContentType ⍝ it overrides a pre-existing content-type header 528 | :EndIf 529 | :EndIf 530 | 531 | simpleChar←{1<≢⍴⍵:0 ⋄ (⎕DR ⍵)∊80 82}parms 532 | 533 | :Select ⊃';'(≠⊆⊢)lc hdrs getHeader'Content-Type' 534 | :Case 'application/x-www-form-urlencoded' 535 | :If ~simpleChar ⍝ if not simple character... 536 | :OrIf ~∧/parms∊ValidFormUrlEncodedChars ⍝ or not valid URL-encoded 537 | parms←UrlEncode parms ⍝ encode it 538 | :EndIf 539 | :Case 'application/json' 540 | :If ~isJSON parms ⍝ if it's not already JSON 541 | parms←JSONexport parms ⍝ JSONify it 542 | :Else 543 | parms←SafeJSON parms 544 | :EndIf 545 | :Else 546 | parms←∊⍕parms 547 | :EndSelect 548 | 549 | :Select UseZip 550 | :Case 1 ⍝ gzip 551 | :Trap 0 552 | parms←toChar 2⊃3 ZipLevel Zipper sint parms 553 | hdrs←'Content-Encoding'(hdrs setHeader)'gzip' 554 | :Else 555 | r.msg←'gzip encoding on request payload failed' 556 | :EndTrap 557 | :Case 2 ⍝ deflate 558 | :Trap 0 559 | parms←toChar 2⊃2 ZipLevel Zipper sint parms 560 | hdrs←'Content-Encoding'(hdrs setHeader)'deflate' 561 | :Else 562 | r.msg←'deflate encoding on request payload failed' 563 | :EndTrap 564 | :EndSelect 565 | 566 | :If RequestOnly>SuppressHeaders ⍝ Conga supplies content-length, but for RequestOnly we need to insert it 567 | hdrs←'Content-Length'(hdrs addHeader)⍴parms 568 | :EndIf 569 | :EndIf 570 | :EndIf 571 | 572 | hdrs⌿⍨←~0∊¨≢¨hdrs[;2] ⍝ remove any headers with empty values 573 | 574 | :If RequestOnly 575 | r←cmd,' ',(path,(0∊⍴urlparms)↓'?',urlparms),' HTTP/1.1',(∊{NL,⍺,': ',∊⍕⍵}/hdrs),NL,NL,parms 576 | →∆EXIT 577 | :EndIf 578 | 579 | (outFile replace)←2↑{⍵,(≢⍵)↓'' 0}eis OutFile 580 | :If 0=outTn ⍝ if we don't already have an output file tied 581 | :If toFile←~0∊⍴outFile ⍝ if we're directing the response payload to file 582 | :Trap Debug↓0 583 | outFile←1 ⎕NPARTS outFile 584 | :If ~⎕NEXISTS⊃outFile 585 | →∆END⊣r.msg←'Output file folder "',(⊃outFile),'" does not exist' 586 | :EndIf 587 | :If 0∊⍴∊1↓outFile ⍝ no file name specified, try to use the name from the URL 588 | :If ~0∊⍴file←∊1↓1 ⎕NPARTS path 589 | outFile←(⊃outFile),file 590 | :Else ⍝ no file name specified and none in the URL 591 | →∆END⊣r.msg←'No file name specified in OutFile or URL' 592 | :EndIf 593 | :EndIf 594 | :If ⎕NEXISTS outFile←∊outFile 595 | :If (0=replace)∧0≠2 ⎕NINFO outFile 596 | →∆END⊣r.msg←'Output file "',outFile,'" is not empty' 597 | :Else 598 | outTn←outFile ⎕NTIE 0 599 | {}0 ⎕NRESIZE⍣(1=replace)⊢outTn 600 | :EndIf 601 | :Else 602 | outTn←outFile ⎕NCREATE 0 603 | :EndIf 604 | startSize←⎕NSIZE outTn 605 | r.OutFile←outFile 606 | tmpFile←tempFolder,'/',(∊1↓1 ⎕NPARTS outFile) ⍝ create temporary file to work with 607 | tmpTn←tmpFile(⎕NCREATE⍠'Unique' 1)0 ⍝ create with a unique name 608 | tmpFile←∊1 ⎕NPARTS ⎕NNAMES[⎕NNUMS⍳tmpTn;] ⍝ save the name for ⎕NDELETE later 609 | :Else 610 | →∆END⊣r.msg←({⍺,(~0∊⍴⍵)/' (',⍵,')'}/⎕DMX.(EM Message)),' occurred while trying to initialize output file "',(⍕outFile),'"' 611 | :EndTrap 612 | :EndIf 613 | :EndIf 614 | 615 | secureParams←'' 616 | :If secure 617 | :AndIf 0≠⊃(rc secureParams)←CreateSecureParams certs 618 | →∆END⊣r.(rc msg)←rc secureParams 619 | :EndIf 620 | 621 | :If proxied 622 | proxy.secureParams←'' 623 | :If proxy.secure 624 | :AndIf 0≠⊃(rc proxy.secureParams)←CreateSecureParams'' 0 625 | →∆END⊣r.(rc msg)←rc('PROXY: ',proxy.secureParams) 626 | :EndIf 627 | :EndIf 628 | 629 | stopIf Debug=2 630 | 631 | :If ~0∊⍴Client ⍝ do we have a client already? 632 | :If 0∊⍴ConxProps ⍝ should never happen (have a client but no connection properties) 633 | Client←'' ⍝ reset client 634 | :ElseIf ConxProps.(Host Port Secure certs)≢r.(Host Port Secure),⊂certs ⍝ something's changed, reset 635 | ⍝ don't set message for same domain 636 | r.msg←(ConxProps.Host≢over{lc ¯2↑'.'(≠⊆⊢)⍵}r.Host)/'Connection properties changed, connection reset' 637 | {}{0::'' ⋄ LDRC.Close ⍵}Client 638 | Client←ConxProps←'' 639 | :ElseIf 'Timeout'≢3⊃LDRC.Wait Client 0 ⍝ nothing changed, make sure client is alive 640 | Client←ConxProps←'' ⍝ connection dropped, reset 641 | :EndIf 642 | :EndIf 643 | 644 | starttime←⎕AI[3] 645 | donetime←⌊starttime+1000×|Timeout ⍝ time after which we'll time out 646 | 647 | :If 0∊⍴Client 648 | options←'' 649 | :If CongaVersion atLeast 3 3 650 | options←⊂'Options'LDRC.Options.DecodeHttp 651 | :EndIf 652 | 653 | :If ~proxied 654 | :If 0≠⊃(err Client)←2↑rc←LDRC.Clt''host port'http'BufferSize,secureParams,options 655 | Client←'' 656 | →∆END⊣r.(rc msg)←err('Conga client creation failed ',,⍕1↓rc) 657 | :EndIf 658 | :Else ⍝ proxied 659 | forceClose←1 ⍝ any error forces client to close, forceClose gets reset later if no proxy connection errors 660 | ⍝ connect to proxy 661 | :If 0≠⊃(err Client)←2↑rc←LDRC.Clt''proxy.host proxy.port'http'BufferSize proxy.secureParams,options 662 | Client←'' 663 | →∆END⊣r.(rc msg)←err('Conga proxy client creation failed ',,⍕1↓rc) 664 | :EndIf 665 | 666 | ⍝ connect to proxied host 667 | :If 0≠err←⊃rc←LDRC.Send Client('CONNECT'(host,':',⍕port)'HTTP/1.1'proxy.headers'') 668 | →∆END⊣r.(rc msg)←err('Proxy CONNECT failed: ',⍕1↓rc) 669 | :EndIf 670 | 671 | :If 0≠err←⊃rc←LDRC.Wait Client 1000 672 | →∆END⊣r.(rc msg)←err('Proxy CONNECT wait failed: ',∊⍕1↓rc) 673 | :Else 674 | (err obj evt dat)←4↑rc 675 | :If evt≢'HTTPHeader' 676 | →∆END⊣r.(rc msg)←err('Proxy CONNECT did not respond with HTTPHeader event: ',∊⍕1↓rc) 677 | :EndIf 678 | :If '200'≢2⊃dat 679 | r.(msg HttpStatus HttpMessage Headers)←(⊂'Proxy CONNECT response failed'),1↓dat 680 | r.HttpStatus←⊃toInt r.HttpStatus 681 | datalen←⊃toInt{0∊⍴⍵:'¯1' ⋄ ⍵}r.GetHeader'Content-Length' ⍝ ¯1 if no content length not specified 682 | →(datalen≠0)↓∆END,∆LISTEN 683 | :EndIf 684 | :EndIf 685 | 686 | ⍝ if secure, upgrade to SSL 687 | :If proxied∧secure 688 | cert←1 2⊃secureParams 689 | :AndIf 0≠err←⊃rc←LDRC.SetProp Client'StartTLS'(cert.AsArg,('SSLValidation' 0)('Address'host)) 690 | →∆END⊣r.(rc msg)←err('Proxy failed to upgrade to secure connection: ',∊⍕1↓rc) 691 | :EndIf 692 | :EndIf 693 | 694 | :If CongaVersion(~atLeast)3 3 695 | :AndIf 0≠err←⊃rc←LDRC.SetProp Client'DecodeBuffers' 15 ⍝ set to decode HTTP messages 696 | →∆END⊣r.(rc msg)←err('Could not set DecodeBuffers on Conga client "',Client,'": ',,⍕1↓rc) 697 | :EndIf 698 | :EndIf 699 | 700 | (ConxProps←⎕NS'').(Host Port Secure certs)←r.(Host Port Secure),⊂certs ⍝ preserve connection settings for subsequent calls 701 | 702 | :If 0=⊃rc←LDRC.Send Client(cmd(path,(0∊⍴urlparms)↓'?',urlparms)'HTTP/1.1'hdrs parms) 703 | 704 | ∆LISTEN: 705 | forceClose←~KeepAlive 706 | (timedOut done data progress noContentLength connectionClose)←0 0 ⍬ 0 0 0 707 | 708 | :Trap 1000 ⍝ in case break is pressed while listening 709 | :While ~done 710 | :If ~done←0≠err←1⊃rc←LDRC.Wait Client WaitTime 711 | (err obj evt dat)←4↑rc 712 | :Select evt 713 | :Case 'HTTPHeader' 714 | :If 1=≡dat 715 | →∆END⊣r.(rc Data msg)←¯1 dat'Conga failed to parse the response HTTP header' ⍝ HTTP header parsing failed? 716 | :Else 717 | r.(HttpVersion HttpStatus HttpMessage Headers)←4↑dat 718 | r.HttpStatus←toInt r.HttpStatus 719 | redirected←3=⌊0.01×r.HttpStatus 720 | datalen←⊃toInt{0∊⍴⍵:'¯1' ⋄ ⍵}r.GetHeader'Content-Length' ⍝ ¯1 if no content length not specified 721 | connectionClose←'close'≡lc r.GetHeader'Connection' 722 | noContentLength←datalen=¯1 723 | done←(cmd≡'HEAD')∨(0=datalen)∨204=r.HttpStatus 724 | →∆END⍴⍨forceClose←r CheckPayloadSize datalen ⍝ we have a payload size limit 725 | :EndIf 726 | :Case 'HTTPBody' 727 | →∆END⍴⍨forceClose←r CheckPayloadSize(≢data)+≢dat 728 | :If toFile>redirected ⍝ don't write redirect response payload to file 729 | →∆END⍴⍨forceClose←r CheckPayloadSize(⎕NSIZE tmpTn)+≢dat 730 | dat ⎕NAPPEND tmpTn 731 | ⎕NUNTIE ⍬ 732 | :Else 733 | data,←dat 734 | :EndIf 735 | done←~noContentLength ⍝ if not content-length specified and not chunked - keep listening 736 | :Case 'HTTPChunk' 737 | :If 1=≡dat 738 | →∆END⊣r.(Data msg)←dat'Conga failed to parse the response HTTP chunk' ⍝ HTTP chunk parsing failed? 739 | :ElseIf toFile>redirected ⍝ don't write redirect response payload to file 740 | →∆END⍴⍨forceClose←r CheckPayloadSize(⎕NSIZE tmpTn)+≢1⊃dat 741 | (1⊃dat)⎕NAPPEND tmpTn 742 | ⎕NUNTIE ⍬ 743 | :Else 744 | →∆END⍴⍨forceClose←r CheckPayloadSize(≢data)+≢1⊃dat 745 | data,←1⊃dat 746 | :EndIf 747 | :Case 'HTTPTrailer' 748 | :If 2≠≢⍴dat 749 | →∆END⊣r.(Data msg)←dat'Conga failed to parse the response HTTP trailer' ⍝ HTTP trailer parsing failed? 750 | :Else 751 | r.Headers⍪←dat ⋄ done←1 752 | :EndIf 753 | :Case 'HTTPFail' 754 | data,←dat 755 | r.Data←data 756 | r.msg←'Conga could not parse the HTTP reponse' 757 | →∆END 758 | :Case 'HTTPError' 759 | data,←dat 760 | r.Data←data 761 | :If noContentLength∧connectionClose 762 | r.(rc msg)←0 '' 763 | done←1 764 | :Else 765 | rc.msg←'Response payload not completely received' 766 | →∆END 767 | :EndIf 768 | :Case 'BlockLast' ⍝ BlockLast included for pre-Conga v3.4 compatibility for RFC7230 (Sec 3.3.3 item 7) 769 | →∆END⍴⍨forceClose←r CheckPayloadSize(≢data)+≢dat 770 | :If toFile0=MaxRedirections ⍝ if redirected and allowing redirections 877 | :If MaxRedirections<.=¯1,≢r.Redirections ⋄ →∆END⊣r.(rc msg)←¯1('Too many redirections (',(⍕MaxRedirections),')') 878 | :Else 879 | :If ''≢url←r.GetHeader'location' ⍝ if we were redirected use the "location" header field for the URL 880 | :If '/'=⊃url ⋄ url,⍨←host ⋄ :EndIf ⍝ if a relative redirection, use the current host 881 | r.Redirections,←t←#.⎕NS'' 882 | t.(URL HttpVersion HttpStatus HttpMessage Headers Data)←r.(URL HttpVersion HttpStatus HttpMessage Headers Data) 883 | {}LDRC.Close Client 884 | cmd←(1+303=r.HttpStatus)⊃cmd'GET' ⍝ 303 (See Other) is always followed by a 'GET'. See https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/303 885 | →∆GET 886 | :Else 887 | r.msg←'Redirection detected, but no "location" header supplied.' ⍝ should never happen from a properly functioning server 888 | :EndIf 889 | :EndIf 890 | :EndIf 891 | :If secure 892 | :AndIf 0=⊃z←LDRC.GetProp Client'PeerCert' 893 | r.PeerCert←2⊃z 894 | :EndIf 895 | :EndIf 896 | :Else 897 | :If 1081=⊃rc ⍝ 1081 could be due to an error in Conga that fails on long URLs, so try sending request as a character vector 898 | :If 0=⊃rc←LDRC.Send Client(cmd,' ',(path,(0∊⍴urlparms)↓'?',urlparms),' HTTP/1.1',(⎕UCS 13 10),(∊': '(⎕UCS 13 10),⍨¨⍤1⊢hdrs),(⎕UCS 13 10),parms) 899 | →∆LISTEN 900 | :EndIf 901 | :EndIf 902 | r.msg←'Conga error while attempting to send request: ',,⍕1↓rc 903 | :EndIf 904 | r.rc←1⊃rc ⍝ set the return code to the Conga return code 905 | ∆END: 906 | ⎕NUNTIE tmpTn,outTn 907 | {0:: ⋄ ⎕NDELETE ⍵}tmpFile 908 | Client←{0::'' ⋄ KeepAlive>forceClose:⍵ ⋄ ''⊣LDRC.Close ⍵}Client 909 | ∆EXIT: 910 | ∇ 911 | 912 | ∇ rc←r CheckPayloadSize size 913 | ⍝ checks if payload exceeds MaxPayloadSize 914 | rc←0 915 | :If MaxPayloadSize≠¯1 916 | :AndIf size>MaxPayloadSize 917 | r.(rc msg)←¯1 'Payload length exceeds MaxPayloadSize' 918 | rc←1 919 | :EndIf 920 | ∇ 921 | 922 | ∇ (timedOut donetime progress)←obj checkTimeOut(donetime progress);tmp;snap 923 | ⍝ check if request has timed out 924 | →∆EXIT↓⍨timedOut←⎕AI[3]>donetime ⍝ exit unless donetime hasn't passed 925 | →∆EXIT↓⍨Timeout<0 ⍝ if Timeout<0, reset donetime if there's progress 926 | →∆EXIT↓⍨0=⊃tmp←LDRC.Tree obj ⍝ look at the current state of the connection 927 | snap←2 2⊃tmp ⍝ second element shoulf contain the state 928 | :If ~0∊⍴snap ⍝ if we have any... 929 | snap←(⊂∘⍋⌷⊢)↑(↑2 2⊃tmp)[;1] ⍝ ...progress should be in elements [4 5] 930 | :EndIf 931 | →∆EXIT⍴⍨progress≡snap ⍝ exit if nothing further received 932 | (timedOut donetime progress)←0(donetime+WaitTime)snap ⍝ reset ticker 933 | ∆EXIT: 934 | ∇ 935 | 936 | ∇ {r}←type UnzipFile tn;data 937 | :Access public shared 938 | ⍝ Unzip an output file 939 | ⍝ type is compression type: ¯2 for gzip, ¯3 for deflate 940 | ⍝ tn is the tie number of the file to unzip 941 | ⍝ r is 0 for success or ⎕EN 942 | :Trap 0 943 | data←⎕NREAD tn 83,(⎕NSIZE tn),0 944 | data←⎕UCS 256|type Zipper data 945 | 0 ⎕NRESIZE tn 946 | data ⎕NAPPEND tn 947 | ⎕NUNTIE ⍬ 948 | r←0 949 | :Else 950 | r←⎕EN 951 | :EndTrap 952 | ∇ 953 | 954 | NL←⎕UCS 13 10 955 | toChar←{(⎕DR'')⎕DR ⍵} 956 | fromutf8←{0::(⎕AV,'?')[⎕AVU⍳⍵] ⋄ 'UTF-8'⎕UCS ⍵} ⍝ Turn raw UTF-8 input into text 957 | utf8←{3=10|⎕DR ⍵: 256|⍵ ⋄ 'UTF-8' ⎕UCS ⍵} 958 | sint←{⎕IO←0 ⋄ 83=⎕DR ⍵:⍵ ⋄ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 ¯128 ¯127 ¯126 ¯125 ¯124 ¯123 ¯122 ¯121 ¯120 ¯119 ¯118 ¯117 ¯116 ¯115 ¯114 ¯113 ¯112 ¯111 ¯110 ¯109 ¯108 ¯107 ¯106 ¯105 ¯104 ¯103 ¯102 ¯101 ¯100 ¯99 ¯98 ¯97 ¯96 ¯95 ¯94 ¯93 ¯92 ¯91 ¯90 ¯89 ¯88 ¯87 ¯86 ¯85 ¯84 ¯83 ¯82 ¯81 ¯80 ¯79 ¯78 ¯77 ¯76 ¯75 ¯74 ¯73 ¯72 ¯71 ¯70 ¯69 ¯68 ¯67 ¯66 ¯65 ¯64 ¯63 ¯62 ¯61 ¯60 ¯59 ¯58 ¯57 ¯56 ¯55 ¯54 ¯53 ¯52 ¯51 ¯50 ¯49 ¯48 ¯47 ¯46 ¯45 ¯44 ¯43 ¯42 ¯41 ¯40 ¯39 ¯38 ¯37 ¯36 ¯35 ¯34 ¯33 ¯32 ¯31 ¯30 ¯29 ¯28 ¯27 ¯26 ¯25 ¯24 ¯23 ¯22 ¯21 ¯20 ¯19 ¯18 ¯17 ¯16 ¯15 ¯14 ¯13 ¯12 ¯11 ¯10 ¯9 ¯8 ¯7 ¯6 ¯5 ¯4 ¯3 ¯2 ¯1[utf8 ⍵]} 959 | lc←{2::0(819⌶)⍵ ⋄ ¯3 ⎕C ⍵} ⍝ lower case conversion 960 | uc←{2::1(819⌶)⍵ ⋄ 1 ⎕C ⍵} ⍝ upper case conversion 961 | ci←{(lc ⍺)⍺⍺ lc ⍵} ⍝ case insensitive operator 962 | deb←' '∘(1↓,(/⍨)1(⊢∨⌽)0,≠) ⍝ delete extraneous blanks 963 | dlb←{(+/∧\' '=⍵)↓⍵} ⍝ delete leading blanks 964 | dltb←{(⌽dlb)⍣2⊢⍵} ⍝ delete leading and trailing blanks 965 | iotaz←((≢⊣)(≥×⊢)⍳) 966 | nameClass←{⎕NC⊂,'⍵'} ⍝ name class of argument 967 | splitOnFirst←{(⍺↑⍨¯1+p)(⍺↓⍨p←⌊/⍺⍳⍵)} ⍝ split ⍺ on first occurrence of ⍵ (removing first ⍵) 968 | splitOn←≠⊆⊣ ⍝ split ⍺ on all ⍵ (removing ⍵) 969 | h2d←{⎕IO←0 ⋄ 16⊥'0123456789abcdef'⍳lc ⍵} ⍝ hex to decimal 970 | d2h←{⎕IO←0 ⋄ '0123456789ABCDEF'[16(⊥⍣¯1)⍵]} ⍝ decimal to hex 971 | getchunklen←{¯1=len←¯1+⊃(NL⍷⍵)/⍳⍴⍵:¯1 ¯1 ⋄ chunklen←h2d len↑⍵ ⋄ (⍴⍵)⍵),1} ⍝ checks if ⍺ is at least version ⍵ 988 | Zipper←219⌶ 989 | tempFolder←739⌶0 990 | 991 | makeURL←{ ⍝ build URL from BaseURL (⍺) and URL (⍵) 992 | ~0∊⍴'^https?\:\/\/'⎕S 3⍠('IC' 1)⊢⍵:⍵ ⍝ URL begins with http:// or https:// 993 | 0∊⍴⍺:⍵ ⍝ no BaseURL 994 | t←'/'=⊃⍵ ⍝ URL begins with '/'? 995 | '/'=⊃⌽⍺:⍺,t↓⍵ ⍝ BaseURL ends with '/' 996 | ⍺,t↓'/',⍵ ⍝ insert '/' if not already there 997 | } 998 | 999 | ∇ r←makeHeaders w 1000 | r←{ 1001 | 0::¯1 ⍝ any error 1002 | ¯1∊⍵:⍵ 1003 | 0∊⍴⍵:0 2⍴⊂'' ⍝ empty 1004 | 1≥|≡⍵:∇{ ⍝ simple array 1005 | 2=⍴⍵:1⊂⍵ ⍝ degenerate case of scalar name and value ('n' 'v' ≡ 'nv') 1006 | dlb¨¨((,⍵)((~∊)⊆⊣)NL)splitOnFirst¨':' 1007 | }⍵ 1008 | 2=⍴⍴⍵:{ ⍝ matrix 1009 | 0∊≢¨⍵[;1]:¯1 ⍝ no empty names 1010 | 0 1 1/0,,¨⍵ ⍝ ensure it's 2 columns 1011 | }⍵ 1012 | 3=|≡⍵:∇{ ⍝ depth 3 1013 | 2|≢⊃,/⍵:¯1 ⍝ ensure an even number of element 1014 | ↑⍵ 1015 | }(eis,)¨⍵ 1016 | 2=|≡⍵:∇{ 1017 | ∧/':'∊¨⍵:⍵ splitOnFirst¨':' 1018 | ((0.5×⍴⍵),2)⍴⍵ 1019 | }⍵ 1020 | ¯1 1021 | }w 1022 | 'Invalid Headers format'⎕SIGNAL 7/⍨r≡¯1 1023 | ∇ 1024 | 1025 | ∇ r←JSONexport data 1026 | :Trap 11 1027 | r←SafeJSON 1(3⊃⎕RSI,##).⎕JSON data ⍝ attempt to export 1028 | :Else 1029 | r←SafeJSON 1(3⊃⎕RSI,##).⎕JSON⍠'HighRank' 'Split'⊢data ⍝ Dyalog v18.0 and later 1030 | :EndTrap 1031 | ∇ 1032 | 1033 | JSONimport←{ 1034 | 0::⍵.(rc msg)←¯2 'Could not translate JSON payload' 1035 | 11::⍵.Data←0(3⊃⎕RSI,##).⎕JSON ⍵.Data 1036 | ⍵.Data←0(3⊃⎕RSI,##).⎕JSON⍠'Dialect' 'JSON5'⊢⍵.Data} 1037 | 1038 | ∇ r←dyalogRoot 1039 | ⍝ return path to interpreter 1040 | r←{⍵,('/\'∊⍨⊢/⍵)↓'/'}{0∊⍴t←2 ⎕NQ'.' 'GetEnvironment' 'DYALOG':⊃1 ⎕NPARTS⊃2 ⎕NQ'.' 'GetCommandLineArgs' ⋄ t}'' 1041 | ∇ 1042 | 1043 | ∇ ns←{ConxProps}ConnectionProperties url;p;defaultPort;ind;msg;protocol;secure;auth;host;port;path;urlparms 1044 | 1045 | :If 0=⎕NC'ConxProps' ⋄ ConxProps←'' ⋄ :EndIf 1046 | 1047 | ns←⎕NS'' 1048 | msg←'' 1049 | (protocol secure host path urlparms)←ConxProps parseURL url 1050 | 1051 | :If ~(⊂protocol)∊'' 'http:' 'https:' 1052 | →∆END⊣msg←'Invalid protocol: ',¯1↓protocol 1053 | :EndIf 1054 | 1055 | auth←'' 1056 | :If 0≠p←¯1↑⍸host='@' ⍝ Handle user:password@host... 1057 | auth←('Basic ',(Base64Encode(p-1)↑host)) 1058 | host←p↓host 1059 | :EndIf 1060 | 1061 | ⍝ This next section is a chicken and egg scenario trying to figure out 1062 | ⍝ whether to use HTTPS as well as what port to use 1063 | 1064 | :If defaultPort←(≢host)0)∧(port≤65535)∧port=⌊port 1078 | →∆END⊣msg←'Invalid port: ',⍕port 1079 | :EndIf 1080 | 1081 | secure∨←(0∊⍴protocol)∧port=443 ⍝ if just port 443 was specified, without any protocol, use SSL 1082 | 1083 | :If defaultPort∧secure 1084 | port←443 1085 | :EndIf 1086 | 1087 | ns.(protocol secure auth host port path urlparms defaultPort)←protocol secure auth host port path urlparms defaultPort 1088 | 1089 | ∆END: 1090 | ns.msg←msg 1091 | ∇ 1092 | 1093 | ∇ (protocol secure host path urlparms)←{conx}parseURL url;path;p;ind 1094 | ⍝ Parses a URL and returns 1095 | ⍝ secure - Boolean whether running HTTPS or not based on leading http:// 1096 | ⍝ host - domain or IP address 1097 | ⍝ path - path on the host for the requested resource, if any 1098 | ⍝ urlparms - URL query string, if any 1099 | :If 0=⎕NC'conx' ⋄ conx←'' ⋄ :EndIf 1100 | (url urlparms)←2↑(url splitOnFirst'?'),⊂'' 1101 | p←⍬⍴2+⍸<\'://'⍷url 1102 | protocol←lc(0⌈p-2)↑url 1103 | secure←protocol beginsWith'https:' 1104 | url←p↓url ⍝ Remove HTTP[s]:// if present 1105 | (host path)←url splitOnFirst'/' ⍝ Extract host and path from url 1106 | ind←host iotaz'@' ⍝ any credentials? 1107 | host←(ind↑host),lc ind↓host ⍝ host (domain) is case-insensitive (credentials are not) 1108 | :If ~0∊⍴conx ⍝ if we have an existing connection 1109 | :AndIf 0∊⍴protocol ⍝ and no protocol was specified 1110 | secure←(conx.Host≡host)∧conx.Secure ⍝ use the protocol from the existing connection 1111 | :EndIf 1112 | path←'/',∊(⊂'%20')@(=∘' ')⊢path ⍝ convert spaces in path name to %20 1113 | ∇ 1114 | 1115 | ∇ r←parseHttpDate date;d 1116 | ⍝ Parses a RFC 7231 format date (Ddd, DD Mmm YYYY hh:mm:ss GMT) 1117 | ⍝ returns Extended IDN format 1118 | ⍝ this function does almost no validation of its input, we expect a properly formatted date 1119 | ⍝ ill-formatted dates return ⍬ 1120 | :Trap 0 1121 | d←{⍵⊆⍨⍵∊⎕A,⎕D}uc date 1122 | r←1 0 1 1 1 1\toInt¨d[4 2 5 6 7] 1123 | r[2]←(3⊃d)⍳⍨12 3⍴'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC' 1124 | r←TStoIDN r 1125 | :Else 1126 | r←⍬ 1127 | :EndTrap 1128 | ∇ 1129 | 1130 | ∇ idn←TStoIDN ts 1131 | ⍝ Convert timestamp to extended IDN format 1132 | :Trap 2 11 ⍝ syntax error if pre-v18.0, domain error if 1133 | idn←¯1 1 ⎕DT⊂ts 1134 | :Else 1135 | idn←(2 ⎕NQ'.' 'DateToIDN'(3↑ts))+(24 60 60 1000⊥4↑3↓ts)÷86400000 1136 | :EndTrap 1137 | ∇ 1138 | 1139 | ∇ ts←IDNtoTS idn 1140 | ⍝ Convert extended IDN to timestamp 1141 | :Trap 2 ⍝ syntax error if pre-v18.0 1142 | ts←⊃1 ¯1 ⎕DT idn 1143 | :Else 1144 | ts←3↑2 ⎕NQ'.' 'IDNToDate'(⌊idn) 1145 | ts,←⌊0.5+24 60 60 1000⊤86400000×1|⍬⍴idn 1146 | :EndTrap 1147 | ∇ 1148 | 1149 | ∇ idn←Now 1150 | ⍝ Return extended IDN for current time 1151 | idn←TStoIDN ⎕TS 1152 | ∇ 1153 | 1154 | ∇ cookies←parseCookies(headers host path);cookie;segs;setcookie;seg;value;name;domain 1155 | ⍝ Parses set-cookie headers into cookie array 1156 | ⍝ Attempts to follow RFC6265 https://datatracker.ietf.org/doc/html/rfc6265 1157 | cookies←⍬ 1158 | :For setcookie :In headers tableGet'set-cookie' 1159 | segs←dltb¨¨2↑¨'='splitOnFirst⍨¨dltb¨setcookie splitOn';' 1160 | (cookie←#.⎕NS'').(Name Value Host Domain Path HttpOnly Secure Expires SameSite Creation Other)←'' ''host'' '/' 0 0 '' ''Now'' 1161 | →∆NEXT⍴⍨0∊≢¨cookie.(Name Value)←⊃segs 1162 | segs←1↓segs 1163 | 1164 | segs/⍨←⌽(⍳∘≢=⍳⍨)⌽lc⊃¨segs ⍝ select the last occurence of each attribute 1165 | :For name value :In segs 1166 | :Select lc name 1167 | :Case 'expires' 1168 | :If ''≡cookie.Expires ⍝ if Expires was set already from MaxAge, MaxAge takes precedence 1169 | →∆NEXT⍴⍨0∊⍴cookie.Expires←parseHttpDate value ⍝ ignore cookies with invalid expires dates 1170 | :EndIf 1171 | :Case 'max-age' ⍝ specifies number of seconds after which cookie expires 1172 | cookie.Expires←Now+seconds toInt value 1173 | :Case 'domain' ⍝ RCF 6265 Sec. 5.2.3 1174 | →∆NEXT⍴⍨0∊⍴domain←lc value ⍝ cookies with empty domain values are ignored 1175 | :If domain≡host 1176 | domain←host 1177 | :ElseIf host endsWith domain←('.'=⊃domain)↓'.',domain 1178 | cookie.Domain←domain 1179 | :Else ⋄ →∆NEXT 1180 | :EndIf 1181 | :Case 'path' ⍝ RCF 6265 Sec. 5.2.4 1182 | :If '/'=⊃value ⋄ cookie.Path←value ⋄ :EndIf 1183 | :Case 'secure' ⋄ cookie.Secure←1 1184 | :Case 'httponly' ⋄ cookie.HttpOnly←1 1185 | :Case 'samesite' ⋄ cookie.SameSite←value 1186 | :Else ⋄ cookie.Other,←⊂dltb¨name value ⍝ catch all in case something else was sent with cookie 1187 | :EndSelect 1188 | :EndFor 1189 | cookies,←cookie 1190 | ∆NEXT: 1191 | :EndFor 1192 | ∇ 1193 | 1194 | NotExpired←{ 1195 | 0∊⍴⍵.Expires:1 1196 | Now≤⍵.Expires 1197 | } 1198 | 1199 | domainMatch←{ 1200 | ⍝ ⍺ - host, ⍵ - cookie.(domain host) 1201 | dom←(1+0∊⍴1⊃⍵)⊃⍵ 1202 | ⍺≡dom:1 1203 | (⍺ endsWith dom)∧'.'=⊃dom 1204 | } 1205 | 1206 | pathMatch←{ 1207 | ⍝ ⍺ - requested path, ⍵ - cookie path 1208 | ⍺ beginsWith ⍵ 1209 | } 1210 | 1211 | ∇ cookies←cookies updateCookies new;cookie;ind 1212 | ⍝ update internal cookies based on result of ParseCookies 1213 | :If 0∊⍴cookies 1214 | cookies←new 1215 | :Else 1216 | :For cookie :In new 1217 | :If 0≠ind←cookies.Name iotaz⊂cookie.Name 1218 | :If 0∊⍴cookie.Value ⍝ deleted cookie? 1219 | cookie←(ind≠⍳≢cookies)/cookies 1220 | :Else 1221 | cookies[ind]←cookie 1222 | :EndIf 1223 | :Else 1224 | cookies,←cookie 1225 | :EndIf 1226 | :EndFor 1227 | :EndIf 1228 | :If ~0∊⍴cookies 1229 | cookies/⍨←NotExpired¨cookies ⍝ remove any expired cookies 1230 | :EndIf 1231 | ∇ 1232 | 1233 | ∇ r←state applyCookies cookies;mask 1234 | ⍝ return which cookies to send based on current request and 1235 | r←⍬ 1236 | →0⍴⍨0∊⍴mask←1⍴⍨≢cookies ⍝ exit if no cookies 1237 | →0↓⍨∨/mask∧←cookies.Secure≤state.Secure ⍝ HTTPS only filter 1238 | →0↓⍨∨/mask←mask\state.Host∘domainMatch¨mask/cookies.(Domain Host) 1239 | →0↓⍨∨/mask←mask\state.Path∘pathMatch¨mask/cookies.Path 1240 | →0↓⍨∨/mask←mask\NotExpired¨mask/cookies 1241 | r←mask/cookies 1242 | ∇ 1243 | 1244 | ∇ r←formatCookies cookies 1245 | r←2↓∊cookies.('; ',Name,'=',Value) 1246 | ∇ 1247 | 1248 | ∇ {r}←name AddHeader value;hdrs 1249 | ⍝ add a header unless it's already defined 1250 | :Access public 1251 | :Trap 7 1252 | r←Headers←name(Headers addHeader)value 1253 | :Else 1254 | ⎕EM ⎕SIGNAL ⎕EN 1255 | :EndTrap 1256 | ∇ 1257 | 1258 | ∇ hdrs←name(hdrs addHeader)value 1259 | ⍝ add a header unless it's already defined 1260 | hdrs←makeHeaders hdrs 1261 | hdrs⍪←('∘???∘'≡hdrs getHeader name)⌿⍉⍪name value 1262 | ∇ 1263 | 1264 | ∇ {r}←name SetHeader value;ind 1265 | ⍝ set a header value, overwriting any existing one 1266 | :Access public 1267 | :Trap 7 1268 | r←Headers←name(Headers setHeader)value 1269 | :Else 1270 | ⎕EM ⎕SIGNAL ⎕EN 1271 | :EndTrap 1272 | ∇ 1273 | 1274 | ∇ hdrs←name(hdrs setHeader)value;ind 1275 | hdrs←makeHeaders hdrs 1276 | ind←hdrs[;1](⍳ci)eis name 1277 | hdrs↑⍨←ind⌈≢hdrs 1278 | hdrs[ind;]←name(⍕value) 1279 | ∇ 1280 | 1281 | ∇ {r}←RemoveHeader name 1282 | ⍝ remove a header 1283 | :Access public 1284 | :Trap 7 1285 | Headers←makeHeaders Headers 1286 | :Else 1287 | ⎕EM ⎕SIGNAL ⎕EN 1288 | :EndTrap 1289 | Headers⌿⍨←Headers[;1](≢¨ci)eis name 1290 | r←Headers 1291 | ∇ 1292 | 1293 | ∇ r←{a}eis w;f 1294 | ⍝ enclose if simple 1295 | f←{⍺←1 ⋄ ,(⊂⍣(⍺=|≡⍵))⍵} 1296 | :If 0=⎕NC'a' ⋄ r←f w 1297 | :Else ⋄ r←a f w 1298 | :EndIf 1299 | ∇ 1300 | 1301 | base64←{(⎕IO ⎕ML)←0 1 ⍝ from dfns workspace - Base64 encoding and decoding as used in MIME. 1302 | chars←'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/' 1303 | bits←{,⍉(⍺⍴2)⊤⍵} ⍝ encode each element of ⍵ in ⍺ bits, and catenate them all together 1304 | part←{((⍴⍵)⍴⍺↑1)⊂⍵} ⍝ partition ⍵ into chunks of length ⍺ 1305 | 0=2|⎕DR ⍵:2∘⊥∘(8∘↑)¨8 part{(-8|⍴⍵)↓⍵}6 bits{(⍵≠64)/⍵}chars⍳⍵ ⍝ decode a string into octets 1306 | four←{ ⍝ use 4 characters to encode either 1307 | 8=⍴⍵:'=='∇ ⍵,0 0 0 0 ⍝ 1, 1308 | 16=⍴⍵:'='∇ ⍵,0 0 ⍝ 2 1309 | chars[2∘⊥¨6 part ⍵],⍺ ⍝ or 3 octets of input 1310 | } 1311 | cats←⊃∘(,/)∘((⊂'')∘,) ⍝ catenate zero or more strings 1312 | cats''∘four¨24 part 8 bits ⍵ 1313 | } 1314 | 1315 | ∇ r←{cpo}Base64Encode w 1316 | ⍝ Base64 Encode 1317 | ⍝ Optional cpo (code points only) suppresses UTF-8 translation 1318 | ⍝ if w is integer skip any conversion 1319 | :Access public shared 1320 | :If (⎕DR w)∊83 163 ⋄ r←base64 w 1321 | :ElseIf 0=⎕NC'cpo' ⋄ r←base64'UTF-8'⎕UCS w 1322 | :Else ⋄ r←base64 ⎕UCS w 1323 | :EndIf 1324 | ∇ 1325 | 1326 | ∇ r←{cpo}Base64Decode w 1327 | ⍝ Base64 Decode 1328 | ⍝ Optional cpo (code points only) suppresses UTF-8 translation 1329 | :Access public shared 1330 | :If 0=⎕NC'cpo' ⋄ r←'UTF-8'⎕UCS base64 w 1331 | :Else ⋄ r←⎕UCS base64 w 1332 | :EndIf 1333 | ∇ 1334 | 1335 | ∇ r←DecodeHeader buf;len;d 1336 | ⍝ Decode HTTP Header 1337 | r←0(0 2⍴⊂'') 1338 | :If 0 'name=fred&type=student' 1352 | ⍝ - a namespace containing variable(s) to be encoded 1353 | ⍝ r is a character vector of the URLEncoded data 1354 | 1355 | :Access Public Shared 1356 | ⎕IO←0 1357 | format←{ 1358 | 1=≡⍵:⍺(,⍕⍵) 1359 | ↑⍺∘{⍺(,⍕⍵)}¨⍵ 1360 | } 1361 | :If 0=⎕NC'name' ⋄ name←'' ⋄ :EndIf 1362 | noname←0 1363 | :If 9.1=⎕NC⊂'data' 1364 | data←⊃⍪/{0∊⍴t←⍵.⎕NL ¯2:'' ⋄ ⍵{⍵ format ⍺⍎⍵}¨t}data 1365 | :Else 1366 | :Select |≡data 1367 | :CaseList 0 1 1368 | :If 1≥|≡data 1369 | noname←0∊⍴name 1370 | data←name(,data) 1371 | :EndIf 1372 | :Case 3 ⍝ nested name/value pairs (('abc' '123')('def' '789')) 1373 | data←⊃,/data 1374 | :EndSelect 1375 | :EndIf 1376 | hex←'%',¨,∘.,⍨⎕D,6↑⎕A 1377 | xlate←{ 1378 | i←⍸~⍵∊'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.~*' 1379 | 0∊⍴i:⍵ 1380 | ∊({⊂∊hex['UTF-8'⎕UCS ⍵]}¨⍵[i])@i⊢⍵ 1381 | } 1382 | data←xlate∘⍕¨data 1383 | r←noname↓¯1↓∊data,¨(⍴data)⍴'=&' 1384 | ∇ 1385 | 1386 | ∇ r←UrlDecode r;rgx;rgxu;i;j;z;t;m;⎕IO;lens;fill 1387 | :Access public shared 1388 | ⎕IO←0 1389 | ((r='+')/r)←' ' 1390 | rgx←'[0-9a-fA-F]' 1391 | rgxu←'%[uU]',(4×⍴rgx)⍴rgx ⍝ 4 characters 1392 | r←(rgxu ⎕R{{⎕UCS 16⊥⍉16|'0123456789ABCDEF0123456789abcdef'⍳⍵}2↓⍵.Match})r 1393 | :If 0≠⍴i←(r='%')/⍳⍴r 1394 | :AndIf 0≠⍴i←(i≤¯2+⍴r)/i 1395 | z←r[j←i∘.+1 2] 1396 | t←'UTF-8'⎕UCS 16⊥⍉16|'0123456789ABCDEF0123456789abcdef'⍳z 1397 | lens←⊃∘⍴¨'UTF-8'∘⎕UCS¨t ⍝ UTF-8 is variable length encoding 1398 | fill←i[¯1↓+\0,lens] 1399 | r[fill]←t 1400 | m←(⍴r)⍴1 ⋄ m[(,j),i~fill]←0 1401 | r←m/r 1402 | :EndIf 1403 | ∇ 1404 | 1405 | ∇ w←SafeJSON w;i;c;⎕IO 1406 | ⍝ Convert Unicode chars to \uXXXX 1407 | ⎕IO←0 1408 | →0⍴⍨0∊⍴i←⍸127⊃⍵:1 ⍝ newer version 1439 | (⊃⍺)=⊃⍵:(1↓⍺)∇ 1↓⍵ 1440 | ¯1 ⍝ older version 1441 | } 1442 | {}LDRC.Close'.' ⍝ close Conga 1443 | LDRC←'' ⍝ reset local reference so that Conga gets reloaded 1444 | :Trap Debug↓0 1445 | ns←⎕NS'' 1446 | code←{⍵⊆⍨~⍵∊⎕UCS 13 10 65279}'UTF-8'⎕UCS ⎕UCS z.Data 1447 | vers←(0 ns.⎕FIX code).Version Version 1448 | :If 1=⊃newer/{2⊃'.'⎕VFI 2⊃⍵}¨vers 1449 | ##.⎕FIX code 1450 | (rc msg)←1(deb⍕,'Upgraded to' 'from',⍪vers) 1451 | :Else 1452 | (rc msg)←0(deb⍕'Already using the most current version: ',2⊃vers) 1453 | :EndIf 1454 | :Else 1455 | msg←'Could not ⎕FIX new HttpCommand: ',2↓∊': '∘,¨⎕DMX.(EM Message) 1456 | :EndTrap 1457 | :Else 1458 | r←¯1('Unexpected ',⊃{⍺,' at ',⍵}/2↑⎕DMX.DM) 1459 | :EndTrap 1460 | ∇ 1461 | :EndClass 1462 | --------------------------------------------------------------------------------