cd2nroff (15580B)
1 #!/usr/bin/env perl 2 #*************************************************************************** 3 # _ _ ____ _ 4 # Project ___| | | | _ \| | 5 # / __| | | | |_) | | 6 # | (__| |_| | _ <| |___ 7 # \___|\___/|_| \_\_____| 8 # 9 # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al. 10 # 11 # This software is licensed as described in the file COPYING, which 12 # you should have received as part of this distribution. The terms 13 # are also available at https://curl.se/docs/copyright.html. 14 # 15 # You may opt to use, copy, modify, merge, publish, distribute and/or sell 16 # copies of the Software, and permit persons to whom the Software is 17 # furnished to do so, under the terms of the COPYING file. 18 # 19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY 20 # KIND, either express or implied. 21 # 22 # SPDX-License-Identifier: curl 23 # 24 ########################################################################### 25 26 =begin comment 27 28 Converts a curldown file to nroff (manpage). 29 30 =end comment 31 =cut 32 33 use strict; 34 use warnings; 35 36 my $cd2nroff = "0.1"; # to keep check 37 my $dir; 38 my $extension; 39 my $keepfilename; 40 41 while(@ARGV) { 42 if($ARGV[0] eq "-d") { 43 shift @ARGV; 44 $dir = shift @ARGV; 45 } 46 elsif($ARGV[0] eq "-e") { 47 shift @ARGV; 48 $extension = shift @ARGV; 49 } 50 elsif($ARGV[0] eq "-k") { 51 shift @ARGV; 52 $keepfilename = 1; 53 } 54 elsif($ARGV[0] eq "-h") { 55 print <<HELP 56 Usage: cd2nroff [options] [file.md] 57 58 -d <dir> Write the output to the file name from the meta-data in the 59 specified directory, instead of writing to stdout 60 -e <ext> If -d is used, this option can provide an added "extension", arbitrary 61 text really, to append to the file name. 62 -h This help text, 63 -v Show version then exit 64 HELP 65 ; 66 exit 0; 67 } 68 elsif($ARGV[0] eq "-v") { 69 print "cd2nroff version $cd2nroff\n"; 70 exit 0; 71 } 72 else { 73 last; 74 } 75 } 76 77 use POSIX qw(strftime); 78 my @ts; 79 if(defined($ENV{SOURCE_DATE_EPOCH})) { 80 @ts = gmtime($ENV{SOURCE_DATE_EPOCH}); 81 } else { 82 @ts = localtime; 83 } 84 my $date = strftime "%Y-%m-%d", @ts; 85 86 sub outseealso { 87 my (@sa) = @_; 88 my $comma = 0; 89 my @o; 90 push @o, ".SH SEE ALSO\n"; 91 for my $s (sort @sa) { 92 push @o, sprintf "%s.BR $s", $comma ? ",\n": ""; 93 $comma = 1; 94 } 95 push @o, "\n"; 96 return @o; 97 } 98 99 sub outprotocols { 100 my (@p) = @_; 101 my $comma = 0; 102 my @o; 103 push @o, ".SH PROTOCOLS\n"; 104 105 if($p[0] eq "TLS") { 106 push @o, "This functionality affects all TLS based protocols: HTTPS, FTPS, IMAPS, POP3S, SMTPS etc."; 107 } 108 else { 109 my @s = sort @p; 110 push @o, "This functionality affects "; 111 for my $e (sort @s) { 112 push @o, sprintf "%s%s", 113 $comma ? (($e eq $s[-1]) ? " and " : ", "): "", 114 lc($e); 115 $comma = 1; 116 } 117 if($#s == 0) { 118 if($s[0] eq "All") { 119 push @o, " supported protocols"; 120 } 121 else { 122 push @o, " only"; 123 } 124 } 125 } 126 push @o, "\n"; 127 return @o; 128 } 129 130 sub outtls { 131 my (@t) = @_; 132 my $comma = 0; 133 my @o; 134 if($t[0] eq "All") { 135 push @o, "\nAll TLS backends support this option."; 136 } 137 elsif($t[0] eq "none") { 138 push @o, "\nNo TLS backend supports this option."; 139 } 140 else { 141 push @o, "\nThis option works only with the following TLS backends:\n"; 142 my @s = sort @t; 143 for my $e (@s) { 144 push @o, sprintf "%s$e", 145 $comma ? (($e eq $s[-1]) ? " and " : ", "): ""; 146 $comma = 1; 147 } 148 } 149 push @o, "\n"; 150 return @o; 151 } 152 153 my %knownprotos = ( 154 'DICT' => 1, 155 'FILE' => 1, 156 'FTP' => 1, 157 'FTPS' => 1, 158 'GOPHER' => 1, 159 'GOPHERS' => 1, 160 'HTTP' => 1, 161 'HTTPS' => 1, 162 'IMAP' => 1, 163 'IMAPS' => 1, 164 'LDAP' => 1, 165 'LDAPS' => 1, 166 'MQTT' => 1, 167 'POP3' => 1, 168 'POP3S' => 1, 169 'RTMP' => 1, 170 'RTMPS' => 1, 171 'RTSP' => 1, 172 'SCP' => 1, 173 'SFTP' => 1, 174 'SMB' => 1, 175 'SMBS' => 1, 176 'SMTP' => 1, 177 'SMTPS' => 1, 178 'TELNET' => 1, 179 'TFTP' => 1, 180 'WS' => 1, 181 'WSS' => 1, 182 'TLS' => 1, 183 'TCP' => 1, 184 'QUIC' => 1, 185 'All' => 1 186 ); 187 188 my %knowntls = ( 189 'GnuTLS' => 1, 190 'mbedTLS' => 1, 191 'OpenSSL' => 1, 192 'rustls' => 1, 193 'Schannel' => 1, 194 'wolfSSL' => 1, 195 'All' => 1, 196 'none' => 1, 197 ); 198 199 sub single { 200 my @seealso; 201 my @proto; 202 my @tls; 203 my $d; 204 my ($f)=@_; 205 my $copyright; 206 my $errors = 0; 207 my $fh; 208 my $line; 209 my $list; 210 my $tlslist; 211 my $section; 212 my $source; 213 my $addedin; 214 my $spdx; 215 my $start = 0; 216 my $title; 217 218 if(defined($f)) { 219 if(!open($fh, "<:crlf", "$f")) { 220 print STDERR "cd2nroff failed to open '$f' for reading: $!\n"; 221 return 1; 222 } 223 } 224 else { 225 $f = "STDIN"; 226 $fh = \*STDIN; 227 binmode($fh, ":crlf"); 228 } 229 while(<$fh>) { 230 $line++; 231 if(!$start) { 232 if(/^---/) { 233 # header starts here 234 $start = 1; 235 } 236 next; 237 } 238 if(/^Title: *(.*)/i) { 239 $title=$1; 240 } 241 elsif(/^Section: *(.*)/i) { 242 $section=$1; 243 } 244 elsif(/^Source: *(.*)/i) { 245 $source=$1; 246 } 247 elsif(/^See-also: +(.*)/i) { 248 $list = 1; # 1 for see-also 249 push @seealso, $1; 250 } 251 elsif(/^See-also: */i) { 252 if($seealso[0]) { 253 print STDERR "$f:$line:1:ERROR: bad See-Also, needs list\n"; 254 return 2; 255 } 256 $list = 1; # 1 for see-also 257 } 258 elsif(/^Protocol:/i) { 259 $list = 2; # 2 for protocol 260 } 261 elsif(/^TLS-backend:/i) { 262 $list = 3; # 3 for TLS backend 263 } 264 elsif(/^Added-in: *(.*)/i) { 265 $addedin=$1; 266 if(($addedin !~ /^[0-9.]+[0-9]\z/) && 267 ($addedin ne "n/a")) { 268 print STDERR "$f:$line:1:ERROR: invalid version number in Added-in line: $addedin\n"; 269 return 2; 270 } 271 } 272 elsif(/^ +- (.*)/i) { 273 # the only lists we support are see-also and protocol 274 if($list == 1) { 275 push @seealso, $1; 276 } 277 elsif($list == 2) { 278 push @proto, $1; 279 } 280 elsif($list == 3) { 281 push @tls, $1; 282 } 283 else { 284 print STDERR "$f:$line:1:ERROR: list item without owner?\n"; 285 return 2; 286 } 287 } 288 # REUSE-IgnoreStart 289 elsif(/^C: (.*)/i) { 290 $copyright=$1; 291 } 292 elsif(/^SPDX-License-Identifier: (.*)/i) { 293 $spdx=$1; 294 } 295 # REUSE-IgnoreEnd 296 elsif(/^---/) { 297 # end of the header section 298 if(!$title) { 299 print STDERR "$f:$line:1:ERROR: no 'Title:' in $f\n"; 300 return 1; 301 } 302 if(!$section) { 303 print STDERR "$f:$line:1:ERROR: no 'Section:' in $f\n"; 304 return 2; 305 } 306 if(!$source) { 307 print STDERR "$f:$line:1:ERROR: no 'Source:' in $f\n"; 308 return 2; 309 } 310 if(($source eq "libcurl") && !$addedin) { 311 print STDERR "$f:$line:1:ERROR: no 'Added-in:' in $f\n"; 312 return 2; 313 } 314 if(!$seealso[0]) { 315 print STDERR "$f:$line:1:ERROR: no 'See-also:' present\n"; 316 return 2; 317 } 318 if(!$copyright) { 319 print STDERR "$f:$line:1:ERROR: no 'C:' field present\n"; 320 return 2; 321 } 322 if(!$spdx) { 323 print STDERR "$f:$line:1:ERROR: no 'SPDX-License-Identifier:' field present\n"; 324 return 2; 325 } 326 if($section == 3) { 327 if(!$proto[0]) { 328 printf STDERR "$f:$line:1:ERROR: missing Protocol:\n"; 329 exit 2; 330 } 331 my $tls = 0; 332 for my $p (@proto) { 333 if($p eq "TLS") { 334 $tls = 1; 335 } 336 if(!$knownprotos{$p}) { 337 printf STDERR "$f:$line:1:ERROR: invalid protocol used: $p:\n"; 338 exit 2; 339 } 340 } 341 # This is for TLS, require TLS-backend: 342 if($tls) { 343 if(!$tls[0]) { 344 printf STDERR "$f:$line:1:ERROR: missing TLS-backend:\n"; 345 exit 2; 346 } 347 for my $t (@tls) { 348 if(!$knowntls{$t}) { 349 printf STDERR "$f:$line:1:ERROR: invalid TLS backend: $t:\n"; 350 exit 2; 351 } 352 } 353 } 354 } 355 last; 356 } 357 else { 358 chomp; 359 print STDERR "$f:$line:1:ERROR: unrecognized header keyword: '$_'\n"; 360 $errors++; 361 } 362 } 363 364 if(!$start) { 365 print STDERR "$f:$line:1:ERROR: no header present\n"; 366 return 2; 367 } 368 369 my @desc; 370 my $quote = 0; 371 my $blankline = 0; 372 my $header = 0; 373 374 # cut off the leading path from the file name, if any 375 $f =~ s/^(.*[\\\/])//; 376 377 push @desc, ".\\\" generated by cd2nroff $cd2nroff from $f\n"; 378 push @desc, ".TH $title $section \"$date\" $source\n"; 379 while(<$fh>) { 380 $line++; 381 382 $d = $_; 383 384 if($quote) { 385 if($quote == 4) { 386 # remove the indentation 387 if($d =~ /^ (.*)/) { 388 push @desc, "$1\n"; 389 next; 390 } 391 else { 392 # end of quote 393 $quote = 0; 394 push @desc, ".fi\n"; 395 next; 396 } 397 } 398 if(/^~~~/) { 399 # end of quote 400 $quote = 0; 401 push @desc, ".fi\n"; 402 next; 403 } 404 # convert single backslashes to doubles 405 $d =~ s/\\/\\\\/g; 406 # lines starting with a period needs it escaped 407 $d =~ s/^\./\\&./; 408 push @desc, $d; 409 next; 410 } 411 412 # remove single line HTML comments 413 $d =~ s/<!--.*?-->//g; 414 415 # **bold** 416 $d =~ s/\*\*(\S.*?)\*\*/\\fB$1\\fP/g; 417 # *italics* 418 $d =~ s/\*(\S.*?)\*/\\fI$1\\fP/g; 419 420 my $back = $d; 421 422 # remove all backticked pieces 423 $back =~ s/\`(.*?)\`//g; 424 425 if($back =~ /[^\\][\<\>]/) { 426 print STDERR "$f:$line:1:ERROR: un-escaped < or > used\n"; 427 $errors++; 428 } 429 # convert backslash-'<' or '> to just the second character 430 $d =~ s/\\([<>])/$1/g; 431 432 # mentions of curl symbols with manpages use italics by default 433 $d =~ s/((lib|)curl([^ ]*\(3\)))/\\fI$1\\fP/gi; 434 435 # backticked becomes italics 436 $d =~ s/\`(.*?)\`/\\fI$1\\fP/g; 437 438 if(/^## (.*)/) { 439 my $word = $1; 440 # if there are enclosing quotes, remove them first 441 $word =~ s/[\"\'\`](.*)[\"\'\`]\z/$1/; 442 443 # enclose in double quotes if there is a space present 444 if($word =~ / /) { 445 push @desc, ".IP \"$word\"\n"; 446 } 447 else { 448 push @desc, ".IP $word\n"; 449 } 450 $header = 1; 451 } 452 elsif(/^##/) { 453 # end of IP sequence 454 push @desc, ".PP\n"; 455 $header = 1; 456 } 457 elsif(/^# (.*)/) { 458 my $word = $1; 459 # if there are enclosing quotes, remove them first 460 $word =~ s/[\"\'](.*)[\"\']\z/$1/; 461 462 if($word eq "PROTOCOLS") { 463 print STDERR "$f:$line:1:WARN: PROTOCOLS section in source file\n"; 464 } 465 elsif($word eq "AVAILABILITY") { 466 print STDERR "$f:$line:1:WARN: AVAILABILITY section in source file\n"; 467 } 468 elsif($word eq "%PROTOCOLS%") { 469 # insert the generated PROTOCOLS section 470 push @desc, outprotocols(@proto); 471 472 if($proto[0] eq "TLS") { 473 push @desc, outtls(@tls); 474 } 475 $header = 1; 476 next; 477 } 478 elsif($word eq "%AVAILABILITY%") { 479 if($addedin ne "n/a") { 480 # insert the generated AVAILABILITY section 481 push @desc, ".SH AVAILABILITY\n"; 482 push @desc, "Added in curl $addedin\n"; 483 } 484 $header = 1; 485 next; 486 } 487 push @desc, ".SH $word\n"; 488 $header = 1; 489 } 490 elsif(/^~~~c/) { 491 # start of a code section, not indented 492 $quote = 1; 493 push @desc, "\n" if($blankline && !$header); 494 $header = 0; 495 push @desc, ".nf\n"; 496 } 497 elsif(/^~~~/) { 498 # start of a quote section; not code, not indented 499 $quote = 1; 500 push @desc, "\n" if($blankline && !$header); 501 $header = 0; 502 push @desc, ".nf\n"; 503 } 504 elsif(/^ (.*)/) { 505 # quoted, indented by 4 space 506 $quote = 4; 507 push @desc, "\n" if($blankline && !$header); 508 $header = 0; 509 push @desc, ".nf\n$1\n"; 510 } 511 elsif(/^[ \t]*\n/) { 512 # count and ignore blank lines 513 $blankline++; 514 } 515 else { 516 # don't output newlines if this is the first content after a 517 # header 518 push @desc, "\n" if($blankline && !$header); 519 $blankline = 0; 520 $header = 0; 521 522 # quote minuses in the output 523 $d =~ s/([^\\])-/$1\\-/g; 524 # replace single quotes 525 $d =~ s/\'/\\(aq/g; 526 # handle double quotes first on the line 527 $d =~ s/^(\s*)\"/$1\\&\"/; 528 529 # lines starting with a period needs it escaped 530 $d =~ s/^\./\\&./; 531 532 if($d =~ /^(.*) /) { 533 printf STDERR "$f:$line:%d:ERROR: 2 spaces detected\n", 534 length($1); 535 $errors++; 536 } 537 if($d =~ /^[ \t]*\n/) { 538 # replaced away all contents 539 $blankline= 1; 540 } 541 else { 542 push @desc, $d; 543 } 544 } 545 } 546 if($fh != \*STDIN) { 547 close($fh); 548 } 549 push @desc, outseealso(@seealso); 550 if($dir) { 551 if($keepfilename) { 552 $title = $f; 553 $title =~ s/\.[^.]*$//; 554 } 555 my $outfile = "$dir/$title.$section"; 556 if(defined($extension)) { 557 $outfile .= $extension; 558 } 559 if(!open(O, ">", $outfile)) { 560 print STDERR "Failed to open $outfile : $!\n"; 561 return 1; 562 } 563 print O @desc; 564 close(O); 565 } 566 else { 567 print @desc; 568 } 569 return $errors; 570 } 571 572 if(@ARGV) { 573 for my $f (@ARGV) { 574 my $r = single($f); 575 if($r) { 576 exit $r; 577 } 578 } 579 } 580 else { 581 exit single(); 582 }