ussg-page (21627B)
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 157 Note: we do not check that you are actually using Markdown. 158 If you are instead using, e.g. mdoc, this should work, and 159 exactly this use is in place on Umbrellix.net and is 160 supported. 161 Default if not specified: env markdown 162 -R/--restricted 163 Restricted mode. Does not scribble on an already existing 164 output file. Instead, balks with EX_CANTCREAT (73). 165 This is not default, but it is recommended to use this if 166 possible. 167 -N/--noheaders 168 The input file does not contain headers. It starts 169 immediately with content. 170 -Q/--quick 171 Not applicable if either file is the standard descriptor. 172 The mtimes of the input and output files are compared. 173 Should the output file not exist, or should it be older 174 than the input file, operate normally. Otherwise, 175 terminate early. 176 177 Specifying multiple short options together will result in them 178 being interpreted separately, including dash options that 179 consume arguments. Unknown dash options will be treated as 180 non-option arguments; you will receive a warning on stderr 181 if this occurs. 182 183 Example (without unknown options): 184 185 %0 -HM .headers "$HOME/.local/src/discount/markdown [options]" 186 Run this program, stdin to stdout, with a headers 187 sidestream of .headers and a Markdown command line 188 of "$HOME/.local/src/discount/markdown [options]" 189 (with dquotes, this'll be interpreted by your shell, then 190 by Tcl in a usage of [open |...]) 191 192 %0 -HM .headers "$HOME/.local/src/discount/markdown [options]" -- -malchik -zhenschina 193 Run this program, ./-malchik to ./-zhenschina, with a 194 headers sidestream of .headers and a Markdown command 195 line of "$HOME/.local/src/discount/markdown [options]" 196 (with dquotes, this'll be interpreted by your shell, then 197 by Tcl in a usage of [open |...]) 198 The etymology of the nonsense words used is Russian for 199 boy and woman. 200 201 Example (with unknown options): 202 203 %0 -HMYZ .headers "$HOME/.local/src/discount/markdown [options]" 204 Run this program, ./-Y to ./-Z, with a headers 205 sidestream of .headers and a Markdown command line 206 of "$HOME/.local/src/discount/markdown [options]" 207 Note: That's probably not what you want, and the behavior will 208 change if those options ever become recognized. 209 Do not invoke this program this way except for a joke. 210 } 211 212 proc printhelp {} { 213 puts stderr [string map [list %0 $::argv0] $::help] 214 } 215 216 set inputfd stdin 217 set outputfd stdout 218 set inputfile "" 219 set outputfile "" 220 set headersfiles [list] 221 set headersfds [list] 222 set markdown "env markdown" 223 set scribble 1 224 set moving 0 ;# 1 means that we'll have to move data after. 225 226 ## Begin command routine 227 228 set headers [list] 229 230 # 0 if it can only be set once, 1 if it can be set inf times 231 # assume 1 232 # Headers are case insensitive and stored in lowercase, so ... 233 set headermulti { 234 title 0 235 title-separator 0 236 template 0 237 x-site-title 0 238 x-site-logo 0 239 x-site-description 0 240 x-synoptic-title 0 241 x-synoptic-text 0 242 x-synoptic-image 0 243 favicon 0 244 style 1 245 verbatim 1 246 execverbatim 1 247 plugin 1 248 url-prefix 0 249 navbar-prefix 0 250 } 251 252 set parsedargs [opts [list h v H: M: N Q help version headers: markdown: noheaders quick] $argv] 253 # opts [list h v H: M: help version headers: markdown:] [list input --markdown /usr/bin/markdown output -HMEQI .headers /usr/bin/markdown -- -EQI -- -- --] 254 # 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 '--'! 255 # 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 '--'! 256 # 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 '--'! 257 # {{markdown /usr/bin/markdown} {H .headers} {M /usr/bin/markdown}} {input output -E -Q -I -EQI -- -- --} 258 259 set firstblankline 0 260 set quick 0 261 262 lassign $parsedargs opts arg 263 264 foreach {opt} $opts { 265 switch -exact -- [lindex $opt 0] { 266 h - 267 help { 268 printhelp 269 exit 64 270 } 271 272 v - 273 version { 274 printversion 275 exit 64 276 } 277 278 H - 279 headers { 280 lappend ::headersfiles [file normalize [lindex $opt 1]] 281 } 282 283 M - 284 markdown { 285 set ::markdown [lindex $opt 1] 286 } 287 288 Q - 289 quick { 290 set ::quick 1 291 } 292 293 N - 294 noheaders { 295 set ::firstblankline 1 296 } 297 298 R - 299 restricted { 300 set ::scribble 0 301 } 302 } 303 } 304 305 proc picktmpfilename {filename} { 306 # blocks until filename does not exist 307 set ext [clock seconds] 308 while {[file exists [format "%s.%s" $filename $ext]]} { 309 incr ext 310 } 311 return [format "%s.%s" $filename $ext] 312 } 313 314 if {[llength $arg] == 2} { 315 set inputfile [lindex $arg 0] 316 set outputfile [lindex $arg 1] 317 if {$outputfile == "-"} { 318 set outputfile "" 319 } else { 320 # In the positive, output file desc is already set correctly. 321 # Alternatively... 322 if {!$::scribble && [file exists $outputfile]} { 323 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] 324 exit 73 325 } 326 set outputdir [file dirname $outputfile] 327 set outputmkdir [list file mkdir] 328 if {![file exists $outputdir]} { 329 while {![file exists $outputdir]} { 330 lappend outputmkdir $outputdir 331 set outputdir [file dirname $outputdir] 332 } 333 } 334 if {[catch $outputmkdir mkdirerr]} { 335 puts stderr [format "Error: directories to contain output file \'%s\' could not be created. \[file mkdir\] reports:" $::outputfile] 336 puts stderr $mkdirerr 337 exit 73 338 } 339 if {$::quick && $::inputfile != "-"} { 340 # spend time to save time 341 if {[file exists $::outputfile] && 342 [file exists $::inputfile]} { 343 if {[set outputmtime [file mtime $::outputfile]] >= [set inputmtime [file mtime $::inputfile]]} { 344 puts stderr [format "Info: output file \'%s\' is newer (%s) than input file \'%s\' (%s)" $::outputfile $outputmtime $::inputfile $inputmtime] 345 exit 0 346 } { 347 puts stderr [format "Info: output file \'%s\' was modified %s, input file \'%s\' was modified (%s)" $::outputfile $outputmtime $::inputfile $inputmtime] 348 } 349 } { 350 puts stderr [format "Info: only one of the two files exists"] 351 } 352 } { 353 puts stderr [format "Info: quick mode disabled, or input file == -"] 354 } 355 if {[catch {open [set ::tmpoutputfile [picktmpfilename [set outputfile [file normalize $outputfile]]]] w} provoutputfd]} { 356 puts stderr [format "Error: temporary output file \'%s\' could not be opened for writing. \[open\] reports:" $::tmpoutputfile] 357 puts stderr $provoutputfd 358 exit 73 359 } { 360 set ::outputfd $provoutputfd 361 set ::moving 1 362 } 363 } 364 } 365 #continue 366 if {[llength $arg] > 0} { 367 set inputfile [lindex $arg 0] 368 if {$inputfile == "-"} { 369 set outputfile "" 370 } else { 371 # In the positive, the input file desc is already set correctly. 372 if {[catch {open [file normalize $inputfile] r} provinputfd]} { 373 puts stderr [format "Error: input file \'%s\' could not be opened for reading. \[open\] reports:" $::inputfile] 374 puts stderr $provinputfd 375 exit 66 376 } { 377 set ::inputfd $provinputfd 378 } 379 } 380 } 381 foreach headersfile $::headersfiles { 382 if {[catch {open [file normalize $headersfile] r} provinputfd]} { 383 puts stderr [format "Error: headers file \'%s\' could not be opened for reading. Balking now; this is fatal. \[open\] reports:" $::headersfile] 384 puts stderr $provinputfd 385 exit 66 386 } { 387 lappend ::headersfds $provinputfd 388 } 389 } 390 391 proc parseheader {lin} { 392 set content [string range [join [lassign [split $lin ":"] word] ":"] 1 end] 393 set word [string tolower $word] 394 puts stderr [format "info: found header %s: %s" $word $content] 395 if {[catch {dict get $::headermulti $word} multi] == 0} { 396 if {$multi} { 397 dict lappend ::headers $word $content 398 } { 399 dict set ::headers $word $content 400 # We will just allow overriding. 401 } 402 } { 403 # Assume 1 404 dict lappend ::headers $word $content 405 } 406 } 407 408 foreach headersfd $::headersfds { 409 while {![eof $headersfd]} { 410 gets $headersfd lin 411 if {$lin != ""} {parseheader $lin} 412 } 413 # we are done, we can close the header now. 414 close $headersfd 415 } 416 417 #firstblankline was set earlier 418 # if it's already 1 (user specified -N) we skip this. 419 420 while {![eof $inputfd] && !$firstblankline} { 421 gets $inputfd lin 422 if {$lin == ""} { 423 set firstblankline 1 424 puts stderr "info: blank line found. Begin processing document as document." 425 } { 426 parseheader $lin 427 } 428 } 429 430 if {[eof $inputfd]} { 431 puts stderr "Error: document file ended without a document. As this would produce an empty document, this is not allowed." 432 exit 66 433 } 434 # Hold up. Stop accepting lines from inputfd. 435 436 # By this stage, we must have a Template: header. 437 # In the template, %%article%% must be on a line by itself as it's expected to be quite large, so unsuitable for [string map]. 438 if {[catch {dict get $::headers template} templatehdr]} { 439 puts stderr $::headers 440 puts stderr [format "Error: template file not specified in headers or document file. Without a template, we cannot create a document."] 441 exit 78 442 } { 443 if {[catch {open [file normalize $templatehdr] r} provinputfd]} { 444 puts stderr [format "Error: template file \'%s\' could not be opened for reading. Balking now; this is fatal. \[open\] reports:" $templatehdr] 445 puts stderr $provinputfd 446 exit 66 447 } { 448 set templfd $provinputfd 449 } 450 } 451 452 proc templcmdsrc {script} { 453 namespacesrc ::templcmds $script 454 } 455 456 proc namespacesrc {namespace script} { 457 if {[catch {open [file normalize $script] r} provinputfd]} { 458 puts stderr [format "Error: namespace \'%s\' file \'%s\' could not be opened for reading. Balking now; this is fatal. \[open\] reports:" $namespace $script] 459 puts stderr $provinputfd 460 exit 66 461 } { 462 set fp $provinputfd 463 } 464 #set fp [open $script r] 465 set ev [list namespace eval $namespace [read $fp]] 466 close $fp 467 uplevel "#0" $ev 468 } 469 470 # proc markdown: fd inputfd 471 # attributes: might block 472 # globals: markdown outputfd 473 # processfd markdown inputfd outputfd 474 # side effects: closes inputfd 475 proc markdown {inputfd} { 476 processfd $::markdown $inputfd $::outputfd 477 chan close $inputfd 478 } 479 480 # proc processfd: string markdown, fd inputfd, fd outputfd 481 # attributes: might block 482 # process the remainder of inputfd, blocking if no data is available, 483 # with the program markdown (which must be a suitable Unix filter), 484 # outputting to outputfd 485 # leaves inputfd at EOF 486 proc processfd {markdown inputfd outputfd} { 487 # finally, our raison d'etre ! 488 # we expect to get eof on input. 489 if {[catch {open [format "|%s" $markdown] r+} err]} { 490 puts stderr [format "Error: processor \'%s\' could not be executed for reading and writing. \[open\] reports:" $markdown] 491 puts stderr $err 492 exit 70 493 } { 494 set mkdownfd $err 495 } 496 chan copy $inputfd $mkdownfd 497 chan flush $mkdownfd 498 chan close $mkdownfd write 499 # begone, input document 500 chan copy $mkdownfd $outputfd 501 chan flush $outputfd 502 chan close $mkdownfd read 503 # begone, markdown 504 } 505 506 namespace eval ::templcmds { 507 proc title {} { 508 # output page title 509 if {[catch {dict get $::headers title} title]} { 510 if {![catch {dict get $::headers navbar-prefix} navprefix]} {set prefix $navprefix} {set prefix ""} 511 if {![catch {dict get $::headers x-site-title} navprefix]} {set title $navprefix} {set title "Site Title Not Set"} 512 if {![catch {dict get $::headers title-separator} sep]} {set sep $sep} {set sep "::"} 513 set filename [string map [list [file normalize $prefix] ""] $::outputfile] 514 append title [format " %s " $sep] 515 append title [string map [list "<" "<" ">" ">" [file separator] [format " %s " $sep]] [string trimleft $filename [file separator]]] 516 } 517 puts $::outputfd [format "<title>%s</title>" $title] 518 } 519 520 proc xsitelogo {} { 521 # output Site Logo code 522 if {![catch {dict get $::headers x-site-logo} title]} { puts -nonewline $::outputfd $title } 523 } 524 525 proc xsitetitle {} { 526 # output Site Title 527 if {![catch {dict get $::headers x-site-title} title]} { puts -nonewline $::outputfd $title } 528 } 529 530 proc xsitedescription {} { 531 if {![catch {dict get $::headers x-site-description} title]} { puts -nonewline $::outputfd $title } 532 } 533 534 proc heads {} { 535 # here we check for synoptic headers, and output them as appropriate 536 # e.g. <link rel="stylesheet" href="/pub/style/style.css" type="text/css" media="screen, handheld" title="default"> 537 if {![catch {dict get $::headers x-synoptic-title} title]} { 538 puts $::outputfd [format "<meta property=\"og:title\" content=\"%s\"></meta>" $title] 539 } 540 if {![catch {dict get $::headers x-synoptic-text} title]} { 541 puts $::outputfd [format "<meta property=\"og:description\" content=\"%s\"></meta>" $title] 542 } 543 if {![catch {dict get $::headers x-synoptic-sitename} title]} { 544 puts $::outputfd [format "<meta property=\"og:site_name\" content=\"%s\"></meta>" $title] 545 } 546 if {![catch {dict get $::headers x-synoptic-image} title]} { 547 puts $::outputfd [format "<meta property=\"og:image\" content=\"%s\"></meta>" $title] 548 } 549 if {![catch {dict get $::headers x-synoptic-url} title]} { 550 puts $::outputfd [format "<meta property=\"og:url\" content=\"%s\"></meta>" $title] 551 } 552 if {![catch {dict get $::headers favicon} title]} { 553 puts $::outputfd [format "<link rel=\"shortcut icon\" href=\"/%s\" type=\"image/vnd.microsoft.icon\">" $title] 554 } 555 if {![catch {dict get $::headers style} title]} { 556 puts $::outputfd [format "<link rel=\"stylesheet\" href=\"/%s\" type=\"text/css\">" $title] 557 } 558 if {![catch {dict get $::headers raw-head} rawheadhdr]} { 559 foreach {rawhead} $rawheadhdr { 560 puts $::outputfd $rawhead 561 } 562 } 563 } 564 565 proc article {} { 566 markdown $::inputfd 567 } 568 569 proc verbatim {num} { 570 set verbatimhdr [lindex [dict get $::headers verbatim] $num] 571 if {![file exists $verbatimhdr]} { 572 puts stderr [format "Warning: verbatim file no. %s \'%s\' does not exist." $num $verbatimhdr] 573 return 574 } 575 if {[catch {open [file normalize $verbatimhdr] r} provinputfd]} { 576 puts stderr [format "Warning: verbatim file no. %s \'%s\' could not be opened for reading. \[open\] reports:" $num $verbatimhdr] 577 puts stderr $provinputfd 578 return 579 } { 580 chan copy $provinputfd $::outputfd 581 chan flush $::outputfd 582 close $provinputfd 583 } 584 } 585 586 namespace export * 587 namespace ensemble create 588 } 589 590 if {![catch {dict get $::headers plugin} pluginhdr]} { 591 foreach {script} $pluginhdr { 592 templcmdsrc $script 593 } 594 } 595 596 proc templcmd {command} { 597 if {[string is entier [string trimleft $command "%"]]} { 598 templcmds verbatim [string trimleft $command "%"] 599 } { 600 templcmds [string trimleft $command "%"] 601 } 602 chan flush $::outputfd 603 } 604 605 # 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. 606 set template [list] 607 while {![eof $templfd]} { 608 lappend template [gets $templfd] 609 } 610 # We're done, we can close the template now 611 close $templfd 612 foreach {tplline} $template { 613 if {[string first "%" [string trimleft $tplline " \t"]] == 0} { 614 # special 615 # a single percentage sign, with only tabs or spaces before it, is a template command. 616 # 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) 617 set tplcmd [string trimleft $tplline " \t"] 618 templcmd $tplcmd 619 } { 620 # just print to $::outputfd 621 puts $::outputfd $tplline 622 } 623 } 624 chan flush $::outputfd 625 chan close $::outputfd 626 627 # Out of the loop: we're getting there... 628 # Moving? If not, we're probably done. 629 if {${moving}} { 630 puts stderr [format "Info: Moving temporary file \'%s\' to its permanent location, \'%s\'" $::tmpoutputfile $::outputfile] 631 if {[catch {file rename -force $::tmpoutputfile $::outputfile} err]} { 632 puts stderr [format "Error: While moving temporary file \'%s\' to its permanent location, \'%s\', \[file rename\] reported:" $::tmpoutputfile $::outputfile] 633 puts stderr $err 634 exit 74 635 } 636 }