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 28Converts a curldown file to nroff (manpage). 29 30=end comment 31=cut 32 33use strict; 34use warnings; 35 36my $cd2nroff = "0.1"; # to keep check 37my $dir; 38my $extension; 39my $keepfilename; 40 41while(@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 56Usage: 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 64HELP 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 77use POSIX qw(strftime); 78my @ts; 79if (defined($ENV{SOURCE_DATE_EPOCH})) { 80 @ts = gmtime($ENV{SOURCE_DATE_EPOCH}); 81} else { 82 @ts = localtime; 83} 84my $date = strftime "%Y-%m-%d", @ts; 85 86sub 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 99sub 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 130sub 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 else { 138 push @o, "\nThis option works only with the following TLS backends:\n"; 139 my @s = sort @t; 140 for my $e (@s) { 141 push @o, sprintf "%s$e", 142 $comma ? (($e eq $s[-1]) ? " and " : ", "): ""; 143 $comma = 1; 144 } 145 } 146 push @o, "\n"; 147 return @o; 148} 149 150my %knownprotos = ( 151 'DICT' => 1, 152 'FILE' => 1, 153 'FTP' => 1, 154 'FTPS' => 1, 155 'GOPHER' => 1, 156 'GOPHERS' => 1, 157 'HTTP' => 1, 158 'HTTPS' => 1, 159 'IMAP' => 1, 160 'IMAPS' => 1, 161 'LDAP' => 1, 162 'LDAPS' => 1, 163 'MQTT' => 1, 164 'POP3' => 1, 165 'POP3S' => 1, 166 'RTMP' => 1, 167 'RTMPS' => 1, 168 'RTSP' => 1, 169 'SCP' => 1, 170 'SFTP' => 1, 171 'SMB' => 1, 172 'SMBS' => 1, 173 'SMTP' => 1, 174 'SMTPS' => 1, 175 'TELNET' => 1, 176 'TFTP' => 1, 177 'WS' => 1, 178 'WSS' => 1, 179 'TLS' => 1, 180 'TCP' => 1, 181 'QUIC' => 1, 182 'All' => 1 183 ); 184 185my %knowntls = ( 186 'BearSSL' => 1, 187 'GnuTLS' => 1, 188 'mbedTLS' => 1, 189 'OpenSSL' => 1, 190 'rustls' => 1, 191 'Schannel' => 1, 192 'Secure Transport' => 1, 193 'wolfSSL' => 1, 194 'All' => 1, 195 ); 196 197sub single { 198 my @seealso; 199 my @proto; 200 my @tls; 201 my $d; 202 my ($f)=@_; 203 my $copyright; 204 my $errors = 0; 205 my $fh; 206 my $line; 207 my $list; 208 my $tlslist; 209 my $section; 210 my $source; 211 my $addedin; 212 my $spdx; 213 my $start = 0; 214 my $title; 215 216 if(defined($f)) { 217 if(!open($fh, "<:crlf", "$f")) { 218 print STDERR "cd2nroff failed to open '$f' for reading: $!\n"; 219 return 1; 220 } 221 } 222 else { 223 $f = "STDIN"; 224 $fh = \*STDIN; 225 binmode($fh, ":crlf"); 226 } 227 while(<$fh>) { 228 $line++; 229 if(!$start) { 230 if(/^---/) { 231 # header starts here 232 $start = 1; 233 } 234 next; 235 } 236 if(/^Title: *(.*)/i) { 237 $title=$1; 238 } 239 elsif(/^Section: *(.*)/i) { 240 $section=$1; 241 } 242 elsif(/^Source: *(.*)/i) { 243 $source=$1; 244 } 245 elsif(/^See-also: +(.*)/i) { 246 $list = 1; # 1 for see-also 247 push @seealso, $1; 248 } 249 elsif(/^See-also: */i) { 250 if($seealso[0]) { 251 print STDERR "$f:$line:1:ERROR: bad See-Also, needs list\n"; 252 return 2; 253 } 254 $list = 1; # 1 for see-also 255 } 256 elsif(/^Protocol:/i) { 257 $list = 2; # 2 for protocol 258 } 259 elsif(/^TLS-backend:/i) { 260 $list = 3; # 3 for TLS backend 261 } 262 elsif(/^Added-in: *(.*)/i) { 263 $addedin=$1; 264 if(($addedin !~ /^[0-9.]+[0-9]\z/) && 265 ($addedin ne "n/a")) { 266 print STDERR "$f:$line:1:ERROR: invalid version number in Added-in line: $addedin\n"; 267 return 2; 268 } 269 } 270 elsif(/^ +- (.*)/i) { 271 # the only lists we support are see-also and protocol 272 if($list == 1) { 273 push @seealso, $1; 274 } 275 elsif($list == 2) { 276 push @proto, $1; 277 } 278 elsif($list == 3) { 279 push @tls, $1; 280 } 281 else { 282 print STDERR "$f:$line:1:ERROR: list item without owner?\n"; 283 return 2; 284 } 285 } 286 # REUSE-IgnoreStart 287 elsif(/^C: (.*)/i) { 288 $copyright=$1; 289 } 290 elsif(/^SPDX-License-Identifier: (.*)/i) { 291 $spdx=$1; 292 } 293 # REUSE-IgnoreEnd 294 elsif(/^---/) { 295 # end of the header section 296 if(!$title) { 297 print STDERR "$f:$line:1:ERROR: no 'Title:' in $f\n"; 298 return 1; 299 } 300 if(!$section) { 301 print STDERR "$f:$line:1:ERROR: no 'Section:' in $f\n"; 302 return 2; 303 } 304 if(!$source) { 305 print STDERR "$f:$line:1:ERROR: no 'Source:' in $f\n"; 306 return 2; 307 } 308 if(($source eq "libcurl") && !$addedin) { 309 print STDERR "$f:$line:1:ERROR: no 'Added-in:' in $f\n"; 310 return 2; 311 } 312 if(!$seealso[0]) { 313 print STDERR "$f:$line:1:ERROR: no 'See-also:' present\n"; 314 return 2; 315 } 316 if(!$copyright) { 317 print STDERR "$f:$line:1:ERROR: no 'C:' field present\n"; 318 return 2; 319 } 320 if(!$spdx) { 321 print STDERR "$f:$line:1:ERROR: no 'SPDX-License-Identifier:' field present\n"; 322 return 2; 323 } 324 if($section == 3) { 325 if(!$proto[0]) { 326 printf STDERR "$f:$line:1:ERROR: missing Protocol:\n"; 327 exit 2; 328 } 329 my $tls = 0; 330 for my $p (@proto) { 331 if($p eq "TLS") { 332 $tls = 1; 333 } 334 if(!$knownprotos{$p}) { 335 printf STDERR "$f:$line:1:ERROR: invalid protocol used: $p:\n"; 336 exit 2; 337 } 338 } 339 # This is for TLS, require TLS-backend: 340 if($tls) { 341 if(!$tls[0]) { 342 printf STDERR "$f:$line:1:ERROR: missing TLS-backend:\n"; 343 exit 2; 344 } 345 for my $t (@tls) { 346 if(!$knowntls{$t}) { 347 printf STDERR "$f:$line:1:ERROR: invalid TLS backend: $t:\n"; 348 exit 2; 349 } 350 } 351 } 352 } 353 last; 354 } 355 else { 356 chomp; 357 print STDERR "$f:$line:1:ERROR: unrecognized header keyword: '$_'\n"; 358 $errors++; 359 } 360 } 361 362 if(!$start) { 363 print STDERR "$f:$line:1:ERROR: no header present\n"; 364 return 2; 365 } 366 367 my @desc; 368 my $quote = 0; 369 my $blankline = 0; 370 my $header = 0; 371 372 # cut off the leading path from the file name, if any 373 $f =~ s/^(.*[\\\/])//; 374 375 push @desc, ".\\\" generated by cd2nroff $cd2nroff from $f\n"; 376 push @desc, ".TH $title $section \"$date\" $source\n"; 377 while(<$fh>) { 378 $line++; 379 380 $d = $_; 381 382 if($quote) { 383 if($quote == 4) { 384 # remove the indentation 385 if($d =~ /^ (.*)/) { 386 push @desc, "$1\n"; 387 next; 388 } 389 else { 390 # end of quote 391 $quote = 0; 392 push @desc, ".fi\n"; 393 next; 394 } 395 } 396 if(/^~~~/) { 397 # end of quote 398 $quote = 0; 399 push @desc, ".fi\n"; 400 next; 401 } 402 # convert single backslahes to doubles 403 $d =~ s/\\/\\\\/g; 404 # lines starting with a period needs it escaped 405 $d =~ s/^\./\\&./; 406 push @desc, $d; 407 next; 408 } 409 410 # remove single line HTML comments 411 $d =~ s/<!--.*?-->//g; 412 413 # **bold** 414 $d =~ s/\*\*(\S.*?)\*\*/\\fB$1\\fP/g; 415 # *italics* 416 $d =~ s/\*(\S.*?)\*/\\fI$1\\fP/g; 417 418 if($d =~ /[^\\][\<\>]/) { 419 print STDERR "$f:$line:1:ERROR: un-escaped < or > used\n"; 420 $errors++; 421 } 422 # convert backslash-'<' or '> to just the second character 423 $d =~ s/\\([<>])/$1/g; 424 425 # mentions of curl symbols with manpages use italics by default 426 $d =~ s/((lib|)curl([^ ]*\(3\)))/\\fI$1\\fP/gi; 427 428 # backticked becomes italics 429 $d =~ s/\`(.*?)\`/\\fI$1\\fP/g; 430 431 if(/^## (.*)/) { 432 my $word = $1; 433 # if there are enclosing quotes, remove them first 434 $word =~ s/[\"\'\`](.*)[\"\'\`]\z/$1/; 435 436 # enclose in double quotes if there is a space present 437 if($word =~ / /) { 438 push @desc, ".IP \"$word\"\n"; 439 } 440 else { 441 push @desc, ".IP $word\n"; 442 } 443 $header = 1; 444 } 445 elsif(/^##/) { 446 # end of IP sequence 447 push @desc, ".PP\n"; 448 $header = 1; 449 } 450 elsif(/^# (.*)/) { 451 my $word = $1; 452 # if there are enclosing quotes, remove them first 453 $word =~ s/[\"\'](.*)[\"\']\z/$1/; 454 455 if($word eq "PROTOCOLS") { 456 print STDERR "$f:$line:1:WARN: PROTOCOLS section in source file\n"; 457 } 458 elsif($word eq "AVAILABILITY") { 459 print STDERR "$f:$line:1:WARN: AVAILABILITY section in source file\n"; 460 } 461 elsif($word eq "%PROTOCOLS%") { 462 # insert the generated PROTOCOLS section 463 push @desc, outprotocols(@proto); 464 465 if($proto[0] eq "TLS") { 466 push @desc, outtls(@tls); 467 } 468 $header = 1; 469 next; 470 } 471 elsif($word eq "%AVAILABILITY%") { 472 if($addedin ne "n/a") { 473 # insert the generated AVAILABILITY section 474 push @desc, ".SH AVAILABILITY\n"; 475 push @desc, "Added in curl $addedin\n"; 476 } 477 $header = 1; 478 next; 479 } 480 push @desc, ".SH $word\n"; 481 $header = 1; 482 } 483 elsif(/^~~~c/) { 484 # start of a code section, not indented 485 $quote = 1; 486 push @desc, "\n" if($blankline && !$header); 487 $header = 0; 488 push @desc, ".nf\n"; 489 } 490 elsif(/^~~~/) { 491 # start of a quote section; not code, not indented 492 $quote = 1; 493 push @desc, "\n" if($blankline && !$header); 494 $header = 0; 495 push @desc, ".nf\n"; 496 } 497 elsif(/^ (.*)/) { 498 # quoted, indented by 4 space 499 $quote = 4; 500 push @desc, "\n" if($blankline && !$header); 501 $header = 0; 502 push @desc, ".nf\n$1\n"; 503 } 504 elsif(/^[ \t]*\n/) { 505 # count and ignore blank lines 506 $blankline++; 507 } 508 else { 509 # don't output newlines if this is the first content after a 510 # header 511 push @desc, "\n" if($blankline && !$header); 512 $blankline = 0; 513 $header = 0; 514 515 # quote minuses in the output 516 $d =~ s/([^\\])-/$1\\-/g; 517 # replace single quotes 518 $d =~ s/\'/\\(aq/g; 519 # handle double quotes first on the line 520 $d =~ s/^(\s*)\"/$1\\&\"/; 521 522 # lines starting with a period needs it escaped 523 $d =~ s/^\./\\&./; 524 525 if($d =~ /^(.*) /) { 526 printf STDERR "$f:$line:%d:ERROR: 2 spaces detected\n", 527 length($1); 528 $errors++; 529 } 530 if($d =~ /^[ \t]*\n/) { 531 # replaced away all contents 532 $blankline= 1; 533 } 534 else { 535 push @desc, $d; 536 } 537 } 538 } 539 if($fh != \*STDIN) { 540 close($fh); 541 } 542 push @desc, outseealso(@seealso); 543 if($dir) { 544 if($keepfilename) { 545 $title = $f; 546 $title =~ s/\.[^.]*$//; 547 } 548 my $outfile = "$dir/$title.$section"; 549 if(defined($extension)) { 550 $outfile .= $extension; 551 } 552 if(!open(O, ">", $outfile)) { 553 print STDERR "Failed to open $outfile : $!\n"; 554 return 1; 555 } 556 print O @desc; 557 close(O); 558 } 559 else { 560 print @desc; 561 } 562 return $errors; 563} 564 565if(@ARGV) { 566 for my $f (@ARGV) { 567 my $r = single($f); 568 if($r) { 569 exit $r; 570 } 571 } 572} 573else { 574 exit single(); 575} 576