ussg-page (21368B)
1 #!/usr/bin/env tclsh8.6 2 3 chan configure stderr -buffering line 4 5 # proc until {test body} {uplevel 1 [list while [concat ! $test] $body]} 6 7 proc opts {{consume {h v H: M: help version headers: markdown:}} argl} { 8 # will always output a list n=2. 9 # [lindex [opts ...] 0] = a list of lists: option, argument(s) 10 # [lindex [opts ...] 1] = a list of arguments not consumed 11 # loptpile contains the long options followed by the number of arguments they consume 12 # a : not immediately preceded by a backslash means that consumed++ 13 # two backslashes collapse to one. 14 # soptpile contains the options which are one letter (one may write -HM header markdown) 15 set loptpile [list] 16 set soptpile [list] 17 foreach {option} $consume { 18 set optname "" 19 set colons 0 20 set prevl "" 21 foreach {l} [split $option {}] { 22 if {$l == ":" && $prevl != "\\"} {incr colons} 23 if {($l != "\\" || $prevl == "\\") && $colons < 1} { 24 append optname $l 25 } 26 if {$prevl != "\\"} {set prevl $l} {set prevl ""} 27 } 28 if {[string length $optname] > 1} {lappend loptpile $optname $colons} {lappend soptpile $optname $colons} 29 } 30 set consumingargs [list] 31 set consumedargs [list] 32 set unconsumedargs [list] 33 set n 0 34 set dashdash 0 35 while {$n < [llength $argl]} { 36 set arg [lindex $argl $n] 37 set colons 0 38 if {$dashdash} { 39 lappend unconsumedargs $arg 40 } { 41 if {[string index $arg 0] == "-"} { 42 if {[string index $arg 1] == "-"} { 43 if {[string length $arg] == 2} {set dashdash 1} { 44 # long opt; consume argument immediately after, even if it starts with a dash 45 # if not a real opt, don't care 46 if {[set colons [dict get $loptpile [string range $arg 2 end]]] != ""} { 47 set consumedarg [list [string range $arg 2 end]] 48 if {$colons != 0} { 49 if {[llength [lrange $argl [expr {$n+1}] [expr {$n+$colons}]]] == $colons} { 50 lappend consumedarg [lrange $argl [expr {$n+1}] [expr {$n+$colons}]] 51 incr n $colons 52 } { 53 return -code error "Reached end of arguments list while consuming arguments for option $arg ([lrange $argl [expr {$n+1}] [expr {$n+$colons}]])" 54 } 55 } 56 lappend consumedargs $consumedarg 57 } { 58 lappend unconsumedargs $arg 59 } 60 } 61 } { 62 if {[string length $arg] == 1} {lappend unconsumedargs $arg} { 63 # short option 64 foreach {letter} [split [string range $arg 1 end] {}] { 65 if {[catch {dict get $soptpile $letter} colons] == 0} { 66 #set colons [dict get $soptpile $letter] 67 set consumedarg [list $letter] 68 if {$colons != 0} { 69 if {[llength [lrange $argl [expr {$n+1}] [expr {$n+$colons}]]] == $colons} { 70 foreach {ar} [lrange $argl [expr {$n+1}] [expr {$n+$colons}]] {lappend consumedarg $ar} 71 incr n $colons 72 } { 73 return -code error "Reached end of arguments list while consuming arguments for option $arg ([lrange $argl [expr {$n+1}] [expr {$n+$colons}]])" 74 } 75 } 76 lappend consumedargs $consumedarg 77 } { 78 # unrecognized dash option - warn user and treat as a separate non-option arg 79 puts stderr [format "warning: option -%s not recognized by this program. Treating as a SEPARATE non-option argument - if this wasn't intended, put the argument containing this option after a \'--\'!" $letter] 80 lappend unconsumedargs [join [list - $letter] {}] 81 } 82 # if there's even zero colons 83 } 84 # foreach letter 85 } 86 # if only dash, else short option 87 } 88 # if two dashes 89 } else { 90 lappend unconsumedargs $arg 91 } 92 # if one dash 93 } 94 # if dashdash 95 incr n 96 } 97 # while 98 return [list $consumedargs $unconsumedargs] 99 } 100 101 set version v0.0-alpha 102 set programname "ussg-page page generator" 103 104 proc printversion {} { 105 puts stderr [format "%s %s (Tcl)" $::programname $::version] 106 puts stderr {All Rights Reserved © 2022 by Ellenor Agnes Bjornsdottir 107 Most activity in the nature of redistributing this application, 108 unmodified or modified, is permitted. See LICENCE for more info. 109 110 This program is, to the extent permitted by applicable law, supplied 111 with no warranty, not even the implied warranties for 112 merchantability or fitness for purpose. Where legally possible, my 113 liability at any remaining warranty claims will be limited to the 114 amount I received in return for you receiving this software. 115 116 Exceptionally: 117 For stable releases, I warrant that the software has been 118 demonstrated to produce usable output on a common UNIX operating 119 system with Tcl 8.6, and using Orc's Discount markdown engine, 120 with the included input data. Your recovery is limited to damage 121 caused by improper operation of the software, which you did not 122 cause, which doesn't appear to be related to defective input 123 or hardware. Bug reports are welcome and are preferred over 124 legal process if possible. 125 } 126 } 127 128 129 set help {usage: %0 [--..] [-hv] [-H headers] [-M /usr/bin/markdown] [--] input [output] 130 131 Generate a complete HTML page from input and headers to output. 132 headers and input are as described in interface.md and 133 ussg-page.1. 134 135 If both input and output are blank, convert stdin to stdout. 136 137 If either input or output are single dashes, convert the respective 138 standard file. 139 140 A double dash terminates option processing, and all arguments 141 are taken as non-options thereafter, including other double 142 dashes. 143 144 Options: 145 -h, --help 146 Display this help. 147 -v, --version 148 Displays the version of this program. 149 -H/--headers [headers] 150 headers file, read before input. input is treated as if 151 it's catenated after headers. 152 May be specified more than once. 153 -M/--markdown [markdown] 154 'Markdown' command line. Must accept Markdown on standard 155 input and produce fragmentary HTML on standard output. 156 Default if not specified: env markdown 157 -R/--restricted 158 Restricted mode. Does not scribble on an already existing 159 output file. Instead, balks with EX_CANTCREAT (73). 160 This is not default, but it is recommended to use this if 161 possible. 162 -N/--noheaders 163 The input file does not contain headers. It starts 164 immediately with content. 165 -Q/--quick 166 Not applicable if either file is the standard descriptor. 167 The mtimes of the input and output files are compared. 168 Should the output file not exist, or should it be older 169 than the input file, 170 171 Specifying multiple short options together will result in them 172 being interpreted separately, including dash options that 173 consume arguments. Unknown dash options will be treated as 174 non-option arguments; you will receive a warning on stderr 175 if this occurs. 176 177 Example (without unknown options): 178 179 %0 -HM .headers "$HOME/.local/src/discount/markdown [options]" 180 Run this program, stdin to stdout, with a headers 181 sidestream of .headers and a Markdown command line 182 of "$HOME/.local/src/discount/markdown [options]" 183 (with dquotes, this'll be interpreted by your shell, then 184 by Tcl in a usage of [open |...]) 185 186 %0 -HM .headers "$HOME/.local/src/discount/markdown [options]" -- -malchik -zhenschina 187 Run this program, ./-malchik to ./-zhenschina, with a 188 headers sidestream of .headers and a Markdown command 189 line of "$HOME/.local/src/discount/markdown [options]" 190 (with dquotes, this'll be interpreted by your shell, then 191 by Tcl in a usage of [open |...]) 192 The etymology of the nonsense words used is Russian for 193 boy and woman. 194 195 Example (with unknown options): 196 197 %0 -HMYZ .headers "$HOME/.local/src/discount/markdown [options]" 198 Run this program, ./-Y to ./-Z, with a headers 199 sidestream of .headers and a Markdown command line 200 of "$HOME/.local/src/discount/markdown [options]" 201 Note: That's probably not what you want, and the behavior will 202 change if those options ever become recognized. 203 Do not invoke this program this way except for a joke. 204 } 205 206 proc printhelp {} { 207 puts stderr [string map [list %0 $::argv0] $::help] 208 } 209 210 set inputfd stdin 211 set outputfd stdout 212 set inputfile "" 213 set outputfile "" 214 set headersfiles [list] 215 set headersfds [list] 216 set markdown "env markdown" 217 set scribble 1 218 set moving 0 ;# 1 means that we'll have to move data after. 219 220 ## Begin command routine 221 222 set headers [list] 223 224 # 0 if it can only be set once, 1 if it can be set inf times 225 # assume 1 226 # Headers are case insensitive and stored in lowercase, so ... 227 set headermulti { 228 title 0 229 title-separator 0 230 template 0 231 x-site-title 0 232 x-site-logo 0 233 x-site-description 0 234 x-synoptic-title 0 235 x-synoptic-text 0 236 x-synoptic-image 0 237 favicon 0 238 style 1 239 verbatim 1 240 execverbatim 1 241 plugin 1 242 url-prefix 0 243 navbar-prefix 0 244 } 245 246 set parsedargs [opts [list h v H: M: N Q help version headers: markdown: noheaders quick] $argv] 247 # opts [list h v H: M: help version headers: markdown:] [list input --markdown /usr/bin/markdown output -HMEQI .headers /usr/bin/markdown -- -EQI -- -- --] 248 # warning: option -E not recognized by this program. Treating as a SEPARATE non-option argument - if this wasn't intended, put the argument containing this option after a '--'! 249 # warning: option -Q not recognized by this program. Treating as a SEPARATE non-option argument - if this wasn't intended, put the argument containing this option after a '--'! 250 # warning: option -I not recognized by this program. Treating as a SEPARATE non-option argument - if this wasn't intended, put the argument containing this option after a '--'! 251 # {{markdown /usr/bin/markdown} {H .headers} {M /usr/bin/markdown}} {input output -E -Q -I -EQI -- -- --} 252 253 set firstblankline 0 254 set quick 0 255 256 lassign $parsedargs opts arg 257 258 foreach {opt} $opts { 259 switch -exact -- [lindex $opt 0] { 260 h - 261 help { 262 printhelp 263 exit 64 264 } 265 266 v - 267 version { 268 printversion 269 exit 64 270 } 271 272 H - 273 headers { 274 lappend ::headersfiles [file normalize [lindex $opt 1]] 275 } 276 277 M - 278 markdown { 279 set ::markdown [lindex $opt 1] 280 } 281 282 Q - 283 quick { 284 set ::quick 1 285 } 286 287 N - 288 noheaders { 289 set ::firstblankline 1 290 } 291 292 R - 293 restricted { 294 set ::scribble 0 295 } 296 } 297 } 298 299 proc picktmpfilename {filename} { 300 # blocks until filename does not exist 301 set ext [clock seconds] 302 while {[file exists [format "%s.%s" $filename $ext]]} { 303 incr ext 304 } 305 return [format "%s.%s" $filename $ext] 306 } 307 308 if {[llength $arg] == 2} { 309 set inputfile [lindex $arg 0] 310 set outputfile [lindex $arg 1] 311 if {$outputfile == "-"} { 312 set outputfile "" 313 } else { 314 # In the positive, output file desc is already set correctly. 315 # Alternatively... 316 if {!$::scribble && [file exists $outputfile]} { 317 puts stderr [format "Error: output file \'%s\' already exists. You asked me not to scribble on it, so I am not scribbling on it." $outputfile] 318 exit 73 319 } 320 set outputdir [file dirname $outputfile] 321 set outputmkdir [list file mkdir] 322 if {![file exists $outputdir]} { 323 while {![file exists $outputdir]} { 324 lappend outputmkdir $outputdir 325 set outputdir [file dirname $outputdir] 326 } 327 } 328 if {[catch $outputmkdir mkdirerr]} { 329 puts stderr [format "Error: directories to contain output file \'%s\' could not be created. \[file mkdir\] reports:" $::outputfile] 330 puts stderr $mkdirerr 331 exit 73 332 } 333 if {$::quick && $::inputfile != "-"} { 334 # spend time to save time 335 if {[file exists $::outputfile] && 336 [file exists $::inputfile]} { 337 if {[set outputmtime [file mtime $::outputfile]] >= [set inputmtime [file mtime $::inputfile]]} { 338 puts stderr [format "Info: output file \'%s\' is newer (%s) than input file \'%s\' (%s)" $::outputfile $outputmtime $::inputfile $inputmtime] 339 exit 0 340 } { 341 puts stderr [format "Info: output file \'%s\' was modified %s, input file \'%s\' was modified (%s)" $::outputfile $outputmtime $::inputfile $inputmtime] 342 } 343 } { 344 puts stderr [format "Info: only one of the two files exists"] 345 } 346 } { 347 puts stderr [format "Info: quick mode disabled, or input file == -"] 348 } 349 if {[catch {open [set ::tmpoutputfile [picktmpfilename [set outputfile [file normalize $outputfile]]]] w} provoutputfd]} { 350 puts stderr [format "Error: temporary output file \'%s\' could not be opened for writing. \[open\] reports:" $::tmpoutputfile] 351 puts stderr $provoutputfd 352 exit 73 353 } { 354 set ::outputfd $provoutputfd 355 set ::moving 1 356 } 357 } 358 } 359 #continue 360 if {[llength $arg] > 0} { 361 set inputfile [lindex $arg 0] 362 if {$inputfile == "-"} { 363 set outputfile "" 364 } else { 365 # In the positive, the input file desc is already set correctly. 366 if {[catch {open [file normalize $inputfile] r} provinputfd]} { 367 puts stderr [format "Error: input file \'%s\' could not be opened for reading. \[open\] reports:" $::inputfile] 368 puts stderr $provinputfd 369 exit 66 370 } { 371 set ::inputfd $provinputfd 372 } 373 } 374 } 375 foreach headersfile $::headersfiles { 376 if {[catch {open [file normalize $headersfile] r} provinputfd]} { 377 puts stderr [format "Error: headers file \'%s\' could not be opened for reading. Balking now; this is fatal. \[open\] reports:" $::headersfile] 378 puts stderr $provinputfd 379 exit 66 380 } { 381 lappend ::headersfds $provinputfd 382 } 383 } 384 385 proc parseheader {lin} { 386 set content [string range [join [lassign [split $lin ":"] word] ":"] 1 end] 387 set word [string tolower $word] 388 puts stderr [format "info: found header %s: %s" $word $content] 389 if {[catch {dict get $::headermulti $word} multi] == 0} { 390 if {$multi} { 391 dict lappend ::headers $word $content 392 } { 393 dict set ::headers $word $content 394 # We will just allow overriding. 395 } 396 } { 397 # Assume 1 398 dict lappend ::headers $word $content 399 } 400 } 401 402 foreach headersfd $::headersfds { 403 while {![eof $headersfd]} { 404 gets $headersfd lin 405 if {$lin != ""} {parseheader $lin} 406 } 407 # we are done, we can close the header now. 408 close $headersfd 409 } 410 411 #firstblankline was set earlier 412 # if it's already 1 (user specified -N) we skip this. 413 414 while {![eof $inputfd] && !$firstblankline} { 415 gets $inputfd lin 416 if {$lin == ""} { 417 set firstblankline 1 418 puts stderr "info: blank line found. Begin processing document as document." 419 } { 420 parseheader $lin 421 } 422 } 423 424 if {[eof $inputfd]} { 425 puts stderr "Error: document file ended without a document. As this would produce an empty document, this is not allowed." 426 exit 66 427 } 428 # Hold up. Stop accepting lines from inputfd. 429 430 # By this stage, we must have a Template: header. 431 # In the template, %%article%% must be on a line by itself as it's expected to be quite large, so unsuitable for [string map]. 432 if {[catch {dict get $::headers template} templatehdr]} { 433 puts stderr $::headers 434 puts stderr [format "Error: template file not specified in headers or document file. Without a template, we cannot create a document."] 435 exit 78 436 } { 437 if {[catch {open [file normalize $templatehdr] r} provinputfd]} { 438 puts stderr [format "Error: template file \'%s\' could not be opened for reading. Balking now; this is fatal. \[open\] reports:" $templatehdr] 439 puts stderr $provinputfd 440 exit 66 441 } { 442 set templfd $provinputfd 443 } 444 } 445 446 proc templcmdsrc {script} { 447 namespacesrc ::templcmds $script 448 } 449 450 proc namespacesrc {namespace script} { 451 if {[catch {open [file normalize $script] r} provinputfd]} { 452 puts stderr [format "Error: namespace \'%s\' file \'%s\' could not be opened for reading. Balking now; this is fatal. \[open\] reports:" $namespace $script] 453 puts stderr $provinputfd 454 exit 66 455 } { 456 set fp $provinputfd 457 } 458 #set fp [open $script r] 459 set ev [list namespace eval $namespace [read $fp]] 460 close $fp 461 uplevel "#0" $ev 462 } 463 464 # proc markdown: fd inputfd 465 # attributes: might block 466 # globals: markdown outputfd 467 # processfd markdown inputfd outputfd 468 # side effects: closes inputfd 469 proc markdown {inputfd} { 470 processfd $::markdown $inputfd $::outputfd 471 chan close $inputfd 472 } 473 474 # proc processfd: string markdown, fd inputfd, fd outputfd 475 # attributes: might block 476 # process the remainder of inputfd, blocking if no data is available, 477 # with the program markdown (which must be a suitable Unix filter), 478 # outputting to outputfd 479 # leaves inputfd at EOF 480 proc processfd {markdown inputfd outputfd} { 481 # finally, our raison d'etre ! 482 # we expect to get eof on input. 483 if {[catch {open [format "|%s" $markdown] r+} err]} { 484 puts stderr [format "Error: processor \'%s\' could not be executed for reading and writing. \[open\] reports:" $markdown] 485 puts stderr $err 486 exit 70 487 } { 488 set mkdownfd $err 489 } 490 chan copy $inputfd $mkdownfd 491 chan flush $mkdownfd 492 chan close $mkdownfd write 493 # begone, input document 494 chan copy $mkdownfd $outputfd 495 chan flush $outputfd 496 chan close $mkdownfd read 497 # begone, markdown 498 } 499 500 namespace eval ::templcmds { 501 proc title {} { 502 # output page title 503 if {[catch {dict get $::headers title} title]} { 504 if {![catch {dict get $::headers navbar-prefix} navprefix]} {set prefix $navprefix} {set prefix ""} 505 if {![catch {dict get $::headers x-site-title} navprefix]} {set title $navprefix} {set title "Site Title Not Set"} 506 if {![catch {dict get $::headers title-separator} sep]} {set sep $sep} {set sep "::"} 507 set filename [string map [list [file normalize $prefix] ""] $::outputfile] 508 append title [format " %s " $sep] 509 append title [string map [list "<" "<" ">" ">" [file separator] [format " %s " $sep]] [string trimleft $filename [file separator]]] 510 } 511 puts $::outputfd [format "<title>%s</title>" $title] 512 } 513 514 proc xsitelogo {} { 515 # output Site Logo code 516 if {![catch {dict get $::headers x-site-logo} title]} { puts -nonewline $::outputfd $title } 517 } 518 519 proc xsitetitle {} { 520 # output Site Title 521 if {![catch {dict get $::headers x-site-title} title]} { puts -nonewline $::outputfd $title } 522 } 523 524 proc xsitedescription {} { 525 if {![catch {dict get $::headers x-site-description} title]} { puts -nonewline $::outputfd $title } 526 } 527 528 proc heads {} { 529 # here we check for synoptic headers, and output them as appropriate 530 # e.g. <link rel="stylesheet" href="/pub/style/style.css" type="text/css" media="screen, handheld" title="default"> 531 if {![catch {dict get $::headers x-synoptic-title} title]} { 532 puts $::outputfd [format "<meta property=\"og:title\" content=\"%s\"></meta>" $title] 533 } 534 if {![catch {dict get $::headers x-synoptic-text} title]} { 535 puts $::outputfd [format "<meta property=\"og:description\" content=\"%s\"></meta>" $title] 536 } 537 if {![catch {dict get $::headers x-synoptic-sitename} title]} { 538 puts $::outputfd [format "<meta property=\"og:site_name\" content=\"%s\"></meta>" $title] 539 } 540 if {![catch {dict get $::headers x-synoptic-image} title]} { 541 puts $::outputfd [format "<meta property=\"og:image\" content=\"%s\"></meta>" $title] 542 } 543 if {![catch {dict get $::headers x-synoptic-url} title]} { 544 puts $::outputfd [format "<meta property=\"og:url\" content=\"%s\"></meta>" $title] 545 } 546 if {![catch {dict get $::headers favicon} title]} { 547 puts $::outputfd [format "<link rel=\"shortcut icon\" href=\"/%s\" type=\"image/vnd.microsoft.icon\">" $title] 548 } 549 if {![catch {dict get $::headers style} title]} { 550 puts $::outputfd [format "<link rel=\"stylesheet\" href=\"/%s\" type=\"text/css\">" $title] 551 } 552 if {![catch {dict get $::headers raw-head} rawheadhdr]} { 553 foreach {rawhead} $rawheadhdr { 554 puts $::outputfd $rawhead 555 } 556 } 557 } 558 559 proc article {} { 560 markdown $::inputfd 561 } 562 563 proc verbatim {num} { 564 set verbatimhdr [lindex [dict get $::headers verbatim] $num] 565 if {![file exists $verbatimhdr]} { 566 puts stderr [format "Warning: verbatim file no. %s \'%s\' does not exist." $num $verbatimhdr] 567 return 568 } 569 if {[catch {open [file normalize $verbatimhdr] r} provinputfd]} { 570 puts stderr [format "Warning: verbatim file no. %s \'%s\' could not be opened for reading. \[open\] reports:" $num $verbatimhdr] 571 puts stderr $provinputfd 572 return 573 } { 574 chan copy $provinputfd $::outputfd 575 chan flush $::outputfd 576 close $provinputfd 577 } 578 } 579 580 namespace export * 581 namespace ensemble create 582 } 583 584 if {![catch {dict get $::headers plugin} pluginhdr]} { 585 foreach {script} $pluginhdr { 586 templcmdsrc $script 587 } 588 } 589 590 proc templcmd {command} { 591 if {[string is entier [string trimleft $command "%"]]} { 592 templcmds verbatim [string trimleft $command "%"] 593 } { 594 templcmds [string trimleft $command "%"] 595 } 596 chan flush $::outputfd 597 } 598 599 # We expect the template to be small enough that reading it, in full, into memory, will not be a problem even on the smallest system we expect to work on. 600 set template [list] 601 while {![eof $templfd]} { 602 lappend template [gets $templfd] 603 } 604 # We're done, we can close the template now 605 close $templfd 606 foreach {tplline} $template { 607 if {[string first "%" [string trimleft $tplline " \t"]] == 0} { 608 # special 609 # a single percentage sign, with only tabs or spaces before it, is a template command. 610 # if it's "article", then print the article. if it's a number, print that number of verbatim (or nothing if it doesn't exist) 611 set tplcmd [string trimleft $tplline " \t"] 612 templcmd $tplcmd 613 } { 614 # just print to $::outputfd 615 puts $::outputfd $tplline 616 } 617 } 618 chan flush $::outputfd 619 chan close $::outputfd 620 621 # Out of the loop: we're getting there... 622 # Moving? If not, we're probably done. 623 if {${moving}} { 624 puts stderr [format "Info: Moving temporary file \'%s\' to its permanent location, \'%s\'" $::tmpoutputfile $::outputfile] 625 if {[catch {file rename -force $::tmpoutputfile $::outputfile} err]} { 626 puts stderr [format "Error: While moving temporary file \'%s\' to its permanent location, \'%s\', \[file rename\] reported:" $::tmpoutputfile $::outputfile] 627 puts stderr $err 628 exit 74 629 } 630 }