2
0

cd2nroff 15 KB

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