Google Git Google Git
Sign in
fuchsia/third_party/curl/refs/heads/main/./scripts/cd2nroff
blob: 4c9050098682dc9263e180016d6149bf4b2687ea [file] [edit]
#!/usr/bin/env perl
#***************************************************************************
# _ _ ____ _
# Project ___| | | | _ \| |
# / __| | | | |_) | |
# | (__| |_| | _ <| |___
# \___|\___/|_| \_\_____|
#
# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
#
# This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms
# are also available at https://curl.se/docs/copyright.html.
#
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
# copies of the Software, and permit persons to whom the Software is
# furnished to do so, under the terms of the COPYING file.
#
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
# KIND, either express or implied.
#
# SPDX-License-Identifier: curl
#
###########################################################################
=begin comment
Converts a curldown file to nroff (manpage).
=end comment
=cut
use strict;
use warnings;
my $cd2nroff = "0.1"; # to keep check
my $dir;
my $extension;
my $keepfilename;
while(@ARGV) {
if($ARGV[0] eq "-d") {
shift @ARGV;
$dir = shift @ARGV;
}
elsif($ARGV[0] eq "-e") {
shift @ARGV;
$extension = shift @ARGV;
}
elsif($ARGV[0] eq "-k") {
shift @ARGV;
$keepfilename = 1;
}
elsif($ARGV[0] eq "-h") {
print <<HELP
Usage: cd2nroff [options] [file.md]
-d <dir> Write the output to the file name from the meta-data in the
specified directory, instead of writing to stdout
-e <ext> If -d is used, this option can provide an added "extension", arbitrary
text really, to append to the file name.
-h This help text,
-v Show version then exit
HELP
;
exit 0;
}
elsif($ARGV[0] eq "-v") {
print "cd2nroff version $cd2nroff\n";
exit 0;
}
else {
last;
}
}
use POSIX qw(strftime);
my @ts;
if (defined($ENV{SOURCE_DATE_EPOCH})) {
@ts = gmtime($ENV{SOURCE_DATE_EPOCH});
} else {
@ts = localtime;
}
my $date = strftime "%Y-%m-%d", @ts;
sub outseealso {
my (@sa) = @_;
my $comma = 0;
my @o;
push @o, ".SH SEE ALSO\n";
for my $s (sort @sa) {
push @o, sprintf "%s.BR $s", $comma ? ",\n": "";
$comma = 1;
}
push @o, "\n";
return @o;
}
sub outprotocols {
my (@p) = @_;
my $comma = 0;
my @o;
push @o, ".SH PROTOCOLS\n";
if($p[0] eq "TLS") {
push @o, "This functionality affects all TLS based protocols: HTTPS, FTPS, IMAPS, POP3S, SMTPS etc.";
}
else {
my @s = sort @p;
push @o, "This functionality affects ";
for my $e (sort @s) {
push @o, sprintf "%s%s",
$comma ? (($e eq $s[-1]) ? " and " : ", "): "",
lc($e);
$comma = 1;
}
if($#s == 0) {
if($s[0] eq "All") {
push @o, " supported protocols";
}
else {
push @o, " only";
}
}
}
push @o, "\n";
return @o;
}
sub outtls {
my (@t) = @_;
my $comma = 0;
my @o;
if($t[0] eq "All") {
push @o, "\nAll TLS backends support this option.";
}
else {
push @o, "\nThis option works only with the following TLS backends:\n";
my @s = sort @t;
for my $e (@s) {
push @o, sprintf "%s$e",
$comma ? (($e eq $s[-1]) ? " and " : ", "): "";
$comma = 1;
}
}
push @o, "\n";
return @o;
}
my %knownprotos = (
'DICT' => 1,
'FILE' => 1,
'FTP' => 1,
'FTPS' => 1,
'GOPHER' => 1,
'GOPHERS' => 1,
'HTTP' => 1,
'HTTPS' => 1,
'IMAP' => 1,
'IMAPS' => 1,
'LDAP' => 1,
'LDAPS' => 1,
'MQTT' => 1,
'POP3' => 1,
'POP3S' => 1,
'RTMP' => 1,
'RTMPS' => 1,
'RTSP' => 1,
'SCP' => 1,
'SFTP' => 1,
'SMB' => 1,
'SMBS' => 1,
'SMTP' => 1,
'SMTPS' => 1,
'TELNET' => 1,
'TFTP' => 1,
'WS' => 1,
'WSS' => 1,
'TLS' => 1,
'TCP' => 1,
'QUIC' => 1,
'All' => 1
);
my %knowntls = (
'BearSSL' => 1,
'GnuTLS' => 1,
'mbedTLS' => 1,
'OpenSSL' => 1,
'rustls' => 1,
'Schannel' => 1,
'Secure Transport' => 1,
'wolfSSL' => 1,
'All' => 1,
);
sub single {
my @seealso;
my @proto;
my @tls;
my $d;
my ($f)=@_;
my $copyright;
my $errors = 0;
my $fh;
my $line;
my $list;
my $tlslist;
my $section;
my $source;
my $addedin;
my $spdx;
my $start = 0;
my $title;
if(defined($f)) {
if(!open($fh, "<:crlf", "$f")) {
print STDERR "cd2nroff failed to open '$f' for reading: $!\n";
return 1;
}
}
else {
$f = "STDIN";
$fh = \*STDIN;
binmode($fh, ":crlf");
}
while(<$fh>) {
$line++;
if(!$start) {
if(/^---/) {
# header starts here
$start = 1;
}
next;
}
if(/^Title: *(.*)/i) {
$title=$1;
}
elsif(/^Section: *(.*)/i) {
$section=$1;
}
elsif(/^Source: *(.*)/i) {
$source=$1;
}
elsif(/^See-also: +(.*)/i) {
$list = 1; # 1 for see-also
push @seealso, $1;
}
elsif(/^See-also: */i) {
if($seealso[0]) {
print STDERR "$f:$line:1:ERROR: bad See-Also, needs list\n";
return 2;
}
$list = 1; # 1 for see-also
}
elsif(/^Protocol:/i) {
$list = 2; # 2 for protocol
}
elsif(/^TLS-backend:/i) {
$list = 3; # 3 for TLS backend
}
elsif(/^Added-in: *(.*)/i) {
$addedin=$1;
if(($addedin !~ /^[0-9.]+[0-9]\z/) &&
($addedin ne "n/a")) {
print STDERR "$f:$line:1:ERROR: invalid version number in Added-in line: $addedin\n";
return 2;
}
}
elsif(/^ +- (.*)/i) {
# the only lists we support are see-also and protocol
if($list == 1) {
push @seealso, $1;
}
elsif($list == 2) {
push @proto, $1;
}
elsif($list == 3) {
push @tls, $1;
}
else {
print STDERR "$f:$line:1:ERROR: list item without owner?\n";
return 2;
}
}
# REUSE-IgnoreStart
elsif(/^C: (.*)/i) {
$copyright=$1;
}
elsif(/^SPDX-License-Identifier: (.*)/i) {
$spdx=$1;
}
# REUSE-IgnoreEnd
elsif(/^---/) {
# end of the header section
if(!$title) {
print STDERR "$f:$line:1:ERROR: no 'Title:' in $f\n";
return 1;
}
if(!$section) {
print STDERR "$f:$line:1:ERROR: no 'Section:' in $f\n";
return 2;
}
if(!$source) {
print STDERR "$f:$line:1:ERROR: no 'Source:' in $f\n";
return 2;
}
if(($source eq "libcurl") && !$addedin) {
print STDERR "$f:$line:1:ERROR: no 'Added-in:' in $f\n";
return 2;
}
if(!$seealso[0]) {
print STDERR "$f:$line:1:ERROR: no 'See-also:' present\n";
return 2;
}
if(!$copyright) {
print STDERR "$f:$line:1:ERROR: no 'C:' field present\n";
return 2;
}
if(!$spdx) {
print STDERR "$f:$line:1:ERROR: no 'SPDX-License-Identifier:' field present\n";
return 2;
}
if($section == 3) {
if(!$proto[0]) {
printf STDERR "$f:$line:1:ERROR: missing Protocol:\n";
exit 2;
}
my $tls = 0;
for my $p (@proto) {
if($p eq "TLS") {
$tls = 1;
}
if(!$knownprotos{$p}) {
printf STDERR "$f:$line:1:ERROR: invalid protocol used: $p:\n";
exit 2;
}
}
# This is for TLS, require TLS-backend:
if($tls) {
if(!$tls[0]) {
printf STDERR "$f:$line:1:ERROR: missing TLS-backend:\n";
exit 2;
}
for my $t (@tls) {
if(!$knowntls{$t}) {
printf STDERR "$f:$line:1:ERROR: invalid TLS backend: $t:\n";
exit 2;
}
}
}
}
last;
}
else {
chomp;
print STDERR "$f:$line:1:ERROR: unrecognized header keyword: '$_'\n";
$errors++;
}
}
if(!$start) {
print STDERR "$f:$line:1:ERROR: no header present\n";
return 2;
}
my @desc;
my $quote = 0;
my $blankline = 0;
my $header = 0;
# cut off the leading path from the file name, if any
$f =~ s/^(.*[\\\/])//;
push @desc, ".\\\" generated by cd2nroff $cd2nroff from $f\n";
push @desc, ".TH $title $section \"$date\" $source\n";
while(<$fh>) {
$line++;
$d = $_;
if($quote) {
if($quote == 4) {
# remove the indentation
if($d =~ /^ (.*)/) {
push @desc, "$1\n";
next;
}
else {
# end of quote
$quote = 0;
push @desc, ".fi\n";
next;
}
}
if(/^~~~/) {
# end of quote
$quote = 0;
push @desc, ".fi\n";
next;
}
# convert single backslahes to doubles
$d =~ s/\\/\\\\/g;
# lines starting with a period needs it escaped
$d =~ s/^\./\\&./;
push @desc, $d;
next;
}
# remove single line HTML comments
$d =~ s/<!--.*?-->//g;
# **bold**
$d =~ s/\*\*(\S.*?)\*\*/\\fB$1\\fP/g;
# *italics*
$d =~ s/\*(\S.*?)\*/\\fI$1\\fP/g;
if($d =~ /[^\\][\<\>]/) {
print STDERR "$f:$line:1:ERROR: un-escaped < or > used\n";
$errors++;
}
# convert backslash-'<' or '> to just the second character
$d =~ s/\\([<>])/$1/g;
# mentions of curl symbols with manpages use italics by default
$d =~ s/((lib|)curl([^ ]*\(3\)))/\\fI$1\\fP/gi;
# backticked becomes italics
$d =~ s/\`(.*?)\`/\\fI$1\\fP/g;
if(/^## (.*)/) {
my $word = $1;
# if there are enclosing quotes, remove them first
$word =~ s/[\"\'\`](.*)[\"\'\`]\z/$1/;
# enclose in double quotes if there is a space present
if($word =~ / /) {
push @desc, ".IP \"$word\"\n";
}
else {
push @desc, ".IP $word\n";
}
$header = 1;
}
elsif(/^##/) {
# end of IP sequence
push @desc, ".PP\n";
$header = 1;
}
elsif(/^# (.*)/) {
my $word = $1;
# if there are enclosing quotes, remove them first
$word =~ s/[\"\'](.*)[\"\']\z/$1/;
if($word eq "PROTOCOLS") {
print STDERR "$f:$line:1:WARN: PROTOCOLS section in source file\n";
}
elsif($word eq "AVAILABILITY") {
print STDERR "$f:$line:1:WARN: AVAILABILITY section in source file\n";
}
elsif($word eq "%PROTOCOLS%") {
# insert the generated PROTOCOLS section
push @desc, outprotocols(@proto);
if($proto[0] eq "TLS") {
push @desc, outtls(@tls);
}
$header = 1;
next;
}
elsif($word eq "%AVAILABILITY%") {
if($addedin ne "n/a") {
# insert the generated AVAILABILITY section
push @desc, ".SH AVAILABILITY\n";
push @desc, "Added in curl $addedin\n";
}
$header = 1;
next;
}
push @desc, ".SH $word\n";
$header = 1;
}
elsif(/^~~~c/) {
# start of a code section, not indented
$quote = 1;
push @desc, "\n" if($blankline && !$header);
$header = 0;
push @desc, ".nf\n";
}
elsif(/^~~~/) {
# start of a quote section; not code, not indented
$quote = 1;
push @desc, "\n" if($blankline && !$header);
$header = 0;
push @desc, ".nf\n";
}
elsif(/^ (.*)/) {
# quoted, indented by 4 space
$quote = 4;
push @desc, "\n" if($blankline && !$header);
$header = 0;
push @desc, ".nf\n$1\n";
}
elsif(/^[ \t]*\n/) {
# count and ignore blank lines
$blankline++;
}
else {
# don't output newlines if this is the first content after a
# header
push @desc, "\n" if($blankline && !$header);
$blankline = 0;
$header = 0;
# quote minuses in the output
$d =~ s/([^\\])-/$1\\-/g;
# replace single quotes
$d =~ s/\'/\\(aq/g;
# handle double quotes first on the line
$d =~ s/^(\s*)\"/$1\\&\"/;
# lines starting with a period needs it escaped
$d =~ s/^\./\\&./;
if($d =~ /^(.*) /) {
printf STDERR "$f:$line:%d:ERROR: 2 spaces detected\n",
length($1);
$errors++;
}
if($d =~ /^[ \t]*\n/) {
# replaced away all contents
$blankline= 1;
}
else {
push @desc, $d;
}
}
}
if($fh != \*STDIN) {
close($fh);
}
push @desc, outseealso(@seealso);
if($dir) {
if($keepfilename) {
$title = $f;
$title =~ s/\.[^.]*$//;
}
my $outfile = "$dir/$title.$section";
if(defined($extension)) {
$outfile .= $extension;
}
if(!open(O, ">", $outfile)) {
print STDERR "Failed to open $outfile : $!\n";
return 1;
}
print O @desc;
close(O);
}
else {
print @desc;
}
return $errors;
}
if(@ARGV) {
for my $f (@ARGV) {
my $r = single($f);
if($r) {
exit $r;
}
}
}
else {
exit single();
}