escape results from the CPAN

escape

App-FuguWeb

view release on metacpan or search on metacpan

# The tool renders mdoc(7) manuals, POD sidecars and Markdown into one
# site. A project describes its site in .fuguwebrc and needs no build
# recipe of its own.
#
# The namespace is an application, not a library. It uses Fugu:: and
# core Perl. It never uses another App:: namespace, and no sibling
# uses it: a sibling application is not a library.
#
# This file holds what more than one module in the namespace needs:
# the name of the configuration file, the name of the stylesheet in
# the output, the escapes that guard a value on its way into HTML,
# the directory listing, and the prefix test.

# The configuration file, at the project root. The name and the
# discovery match .fuguvmrc.
use constant CONFIG_FILE => '.fuguwebrc';

# The stylesheet, as the output directory holds it and as every page
# links it. The site is served from one flat directory, so the name
# is a file name there.
use constant STYLESHEET => 'style.css';

# The staging directory for the mdoc sources, inside the output
# directory. The build makes it, uses it, and removes it again.
#
# The name lives here because two modules need it. The build owns the
# directory. The description must refuse a key directory of the same
# name, because the build would remove the published keys with the
# staging.
use constant STAGING_DIR => '.man';

# escape_html($text):
#	Escape the three characters that change the meaning of HTML
#	text: the ampersand first, so an escape that the function
#	itself writes is not escaped again.
#
#	The function takes bytes and returns bytes. No file in the
#	namespace carries 'use utf8', so a multi-byte character passes
#	through untouched.
sub escape_html ($text)
{
	return '' unless defined $text;

	my $escaped = $text;
	$escaped =~ s/&/&amp;/g;
	$escaped =~ s/</&lt;/g;
	$escaped =~ s/>/&gt;/g;

	return $escaped;
}

# escape_attr($text):
#	Escape a value on its way into a double-quoted attribute. The
#	quote is the character that matters here: a value that holds
#	one ends the attribute early, and everything after it becomes
#	markup. escape_html alone does not guard an attribute.
sub escape_attr ($text)
{
	my $escaped = escape_html($text);
	$escaped =~ s/"/&quot;/g;

	return $escaped;
}

# list_dir($dir):
#	The names in one directory, sorted, without '.' and '..'. The
#	function returns an array reference, or undef with the reason
#	in $!, so a caller can tell an empty directory from one it
#	cannot read.
#
#	The sort compares bytes and never reads the locale of the
#	builder: a site must not depend on the machine that built it.

lib/App/FuguWeb.pod view on Meta::CPAN


App::FuguWeb - a static documentation site for a Perl project

=head1 SYNOPSIS

    fuguweb build --out web/build
    fuguweb check --out web/build

    use App::FuguWeb;

    my $safe = App::FuguWeb::escape_html($title);
    my $file = App::FuguWeb::CONFIG_FILE;      # .fuguwebrc

=head1 DESCRIPTION

C<fuguweb> renders one static site from the documentation that a Perl
project already keeps: mdoc(7) manuals, POD sidecars, and Markdown.
There is no templating language and no JavaScript. The tool runs
C<mandoc>, C<lowdown>, and C<pod2man>, and wraps each result in one
shared chrome.

lib/App/FuguWeb.pod view on Meta::CPAN


Subcommand dispatch over L<Fugu::CLI>.

=back

=head1 THE CONFIGURATION FILE

F<.fuguwebrc> sits at the project root and uses the L<Fugu::Config>
grammar: a setting on a line of its own, and a block that opens with a
brace at the end of its header line. A C<#> starts a comment, and the
grammar has no escape for it, so a value may not hold one.

    site       = OpenHAP
    out_dir    = web/build
    source_dir = web
    entry      = index.html

    nav "fugu.html" {
            label = Fugu
    }

lib/App/FuguWeb.pod view on Meta::CPAN

the build copies it; L<App::FuguWeb::Site/ASSETS> says exactly which
those are.

A C<keys> block and its C<key> blocks describe the published key
directory of an organization. L<App::FuguWeb::Keys> documents them.

L<App::FuguWeb::Config> documents every setting and every default.

=head1 FUNCTIONS

=head2 escape_html

    my $safe = App::FuguWeb::escape_html($text);

Escape C<&>, C<< < >> and C<< > >>, in that order. The function takes
bytes and returns bytes: no file in the namespace carries C<use utf8>,
so a multi-byte character passes through untouched.

=head2 escape_attr

    my $safe = App::FuguWeb::escape_attr($text);

The same, plus the double quote. Use it for a value on its way into a
double-quoted attribute: a value that holds a quote ends the attribute
early, and everything after it becomes markup. L</escape_html> alone
does not guard an attribute.

=head2 list_dir

    my $names = App::FuguWeb::list_dir($dir) or die "cannot read: $!";

The names in one directory, sorted, without C<.> and C<..>. The
function returns an array reference, or C<undef> with the reason in
C<$!>, so a caller can tell an empty directory from one it cannot
read.

lib/App/FuguWeb/Check.pm view on Meta::CPAN

	my $html = Fugu::File->read( $self->{out} . "/$page" ) // '';
	my @problems;

	my ($title) = $html =~ m{<title>([^<]*)</title>};
	push @problems, "$page: has no title"
	    unless defined $title && length $title;

	for my $entry ( $self->{config}->nav ) {
		my $href = $entry->{href};

		# The chrome escapes an attribute on its way out, so the
		# search has to escape it the same way. A page below the
		# root also carries the step back, so the search reads
		# the same form that App::FuguWeb::Page writes.
		my $written = App::FuguWeb::escape_attr($href);
		$written = _base_of($page) . $written
		    unless $href =~ m{\A(?:[A-Za-z][A-Za-z0-9.+-]*:|/|\#)};

		push @problems,
		    "$page: does not carry the navigation" . " entry $href"
		    unless index( $html, qq{href="$written"} ) >= 0;
	}

	push @problems, $self->_check_references( $page, $html );

	return @problems;
}

# $self->_check_references($page, $html):
#	Every href and src of one page.
sub _check_references ( $self, $page, $html )
{
	my @problems;

	for my $ref ( map { _unescape($_) }
		$html =~ m{(?:href|src)="([^"]+)"}g )
	{

		# The host may serve the site from a path below the
		# root, where a leading slash leaves the site entirely.
		if ( $ref =~ m{^/} ) {
			push @problems, "$page: $ref is root-absolute";
			next;
		}
		if ( $ref =~ m{^file:}i ) {

lib/App/FuguWeb/Check.pm view on Meta::CPAN


	# A reference of './' names the directory of its own page, and
	# a directory is no page of a site. An empty answer also reads
	# as false in the walk of the reachability check. The walk
	# would then stop at the first page that holds one.
	return unless @parts;

	return join '/', @parts;
}

# _unescape($text):
#	Turn the four attribute entities back into their characters. A
#	reference is compared against a file name, and the file holds
#	the character and not the entity.
sub _unescape ($text)
{
	my $plain = $text;
	$plain =~ s/&lt;/</g;
	$plain =~ s/&gt;/>/g;
	$plain =~ s/&quot;/"/g;
	$plain =~ s/&amp;/&/g;

	return $plain;
}

lib/App/FuguWeb/Check.pm view on Meta::CPAN

	return "$entry: the entry page is missing"
	    unless -f $self->{out} . "/$entry";

	my %seen  = ( $entry => 1 );
	my @queue = ($entry);

	while ( my $page = shift @queue ) {
		next unless $page =~ /\.html$/;

		my $html = Fugu::File->read( $self->{out} . "/$page" ) // '';
		for my $ref ( map { _unescape($_) }
			$html =~ m{(?:href|src)="([^"]+)"}g )
		{
			next if $ref =~ m{^[A-Za-z][A-Za-z0-9.+-]*:};

			my ($path) = split /#/, $ref, 2;
			next unless defined $path && length $path;
			$path = _resolve( $page, $path );
			next unless defined $path;

			next if $seen{$path}++;

lib/App/FuguWeb/Index.pm view on Meta::CPAN

	my $path = $self->{config}->source_path(OPENING_FRAGMENT);
	return Fugu::File->read($path) // '' if -f $path;

	my $url  = $self->{config}->man_url;
	my $host = $url;
	$host =~ s{^[a-z]+://}{};
	$host =~ s{/$}{};

	return
	      '<h1>'
	    . App::FuguWeb::escape_html( $self->title )
	    . "</h1>\n" . "\n"
	    . '<p>These pages come from the same sources that'
	    . " <code>man</code> reads on an\n"
	    . 'installed system.  Cross-references between these pages'
	    . " are links; all\n"
	    . "other cross-references go to\n"
	    . qq{<a href="$url">$host</a>.</p>\n} . "\n";
}

# $self->_group($group):
#	One heading and one description list. A group with no manual
#	emits nothing, so an empty group leaves no heading behind.
sub _group ( $self, $group )
{
	my @manuals = $group->manuals;
	return '' unless @manuals;

	my $html =
	      '<h2 id="'
	    . App::FuguWeb::escape_attr( $group->anchor ) . '">'
	    . App::FuguWeb::escape_html( $group->heading )
	    . "</h2>\n<dl>\n";
	$html .= _entry($_) for @manuals;
	$html .= "</dl>\n\n";

	return $html;
}

# _entry($manual):
#	One term and one definition. The './' is mandatory: a browser
#	reads a relative URL whose first segment holds a colon as a
#	scheme, and a module page is named App::FuguWeb.3p.html.
sub _entry ($manual)
{
	my $name    = App::FuguWeb::escape_html( $manual->name );
	my $section = $manual->section;

	return
	    sprintf "<dt><a href=\"./%s\">%s(%s)</a></dt>\n" . "<dd>%s</dd>\n",
	    App::FuguWeb::escape_attr( $manual->page ), $name, $section,
	    App::FuguWeb::escape_html( $manual->description );
}

1;

lib/App/FuguWeb/Keys.pm view on Meta::CPAN

#	fails the same way.
sub _fail ( $self, $reason )
{
	$self->{error} = $reason;

	return;
}

# _index_body($rows, $by_target):
#	The body fragment of the human page: one row for each key, in
#	publication order. Every value is escaped, and a value that
#	the description left out becomes an empty cell.
#
#	The subject and the validity cells hold the two facts of a
#	certificate, per WEB-X509-5, and a key of another type leaves
#	them empty.
#
#	The last cell of a row holds the bindings of that key, per
#	WEB-TRUST-11. Each one names its signer and links its file, so
#	a reader fetches the signature beside the key that it covers.
sub _index_body ( $rows, $by_target )

lib/App/FuguWeb/Keys.pm view on Meta::CPAN

		'Key',    'Purpose',     'Serial',  'Type',
		'Status', 'Fingerprint', 'Subject', 'Validity',
		'Since',  'Until',       'Bindings'
	);

	my $html = "<h1>Keys</h1>\n<table>\n<thead>\n<tr>";
	$html .= "<th>$_</th>" for @head;
	$html .= "</tr>\n</thead>\n<tbody>\n";

	for my $row (@$rows) {
		my $href = App::FuguWeb::escape_attr( $row->{name} );
		my $stem = App::FuguWeb::escape_html( $row->{stem} );

		$html .= qq{<tr><td><a href="$href">$stem</a></td>};
		$html .= '<td>' . _cell( $row->{$_} ) . '</td>'
		    for qw(purpose serial type status fingerprint
		    subject validity since until);
		$html .= '<td>'
		    . _bindings( $by_target->{ $row->{name} } ) . "</td>";
		$html .= "</tr>\n";
	}

lib/App/FuguWeb/Keys.pm view on Meta::CPAN

# _bindings($bindings):
#	The binding cell of one key: one link for each binding, named
#	by the signer of it. A key that no binding covers gives an
#	empty cell, so the row keeps its column count.
sub _bindings ($bindings)
{
	return '' unless $bindings;

	my @link;
	for my $binding ( sort { $a->{name} cmp $b->{name} } @$bindings ) {
		my $href = App::FuguWeb::escape_attr( $binding->{name} );
		my $stem = App::FuguWeb::escape_html(
			$binding->{signer} =~ s/\.[^.]+\z//r );

		push @link, qq{<a href="$href">$stem</a>};
	}

	return join ', ', @link;
}

# _cell($value):
#	One table cell. A value that the description left out becomes
#	an empty cell, so a template tests one thing and the row keeps
#	its column count.
sub _cell ($value)
{
	return defined $value ? App::FuguWeb::escape_html($value) : '';
}

# _digest_of($path):
#	The lowercase hex SHA256 digest of the file, or undef when the
#	file does not open. addfile reads in blocks, so the check
#	never holds a whole key set in memory.
sub _digest_of ($path)
{
	open my $fh, '<', $path or return;
	binmode $fh;

lib/App/FuguWeb/Page.pm view on Meta::CPAN

# $self->document($title, $fragment):
#	The whole page as bytes. A caller that writes the file itself,
#	or that holds the page beside other generated bytes, reads the
#	document here and never repeats the chrome.
sub document ( $self, $title, $fragment )
{
	return $self->_head($title) . ( $fragment // '' ) . $self->_foot;
}

# $self->_head($title):
#	Everything before the fragment. Every value is escaped before
#	the heredoc reads it, so nothing raw reaches the markup.
sub _head ( $self, $title )
{
	my $config = $self->{config};

	my $site  = App::FuguWeb::escape_html( $config->site );
	my $lang  = App::FuguWeb::escape_attr( $config->lang );
	my $entry = $self->_link( $config->entry );
	my $full = App::FuguWeb::escape_html($title) . ' ' . EM_DASH . " $site";
	my $sheet = $self->_link(App::FuguWeb::STYLESHEET);

	return <<"HTML" . $self->_nav . "<hr>\n<main>\n";
<!DOCTYPE html>
<html lang="$lang">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>$full</title>
<link rel="stylesheet" href="$sheet">

lib/App/FuguWeb/Page.pm view on Meta::CPAN

#	The navigation. The separator joins the entries, so the row
#	does not end in a dangling dot.
sub _nav ($self)
{
	my @entries = $self->{config}->nav;
	return "" unless @entries;

	my @links = map {
		      '<a href="'
		    . $self->_link( $_->{href} ) . '">'
		    . App::FuguWeb::escape_html( $_->{label} ) . '</a>'
	} @entries;

	return
	      "<nav>\n"
	    . join( ' ' . MIDDLE_DOT . "\n", @links )
	    . "\n</nav>\n";
}

# $self->_link($href):
#	One href of the chrome, escaped, with the step back to the
#	site root in front of it.
#
#	The step goes in front of a relative name only. An absolute
#	URL, a root-absolute path and a fragment each name a place of
#	their own. A step in front of one would name a page that the
#	site does not hold.
sub _link ( $self, $href )
{
	my $written = App::FuguWeb::escape_attr($href);

	return $written if $href =~ m{\A(?:[A-Za-z][A-Za-z0-9.+-]*:|/|\#)};

	return $self->{base} . $written;
}

# $self->_foot:
#	Everything after the fragment. A project with no footer
#	fragment gets no footer element and no rule before it: an
#	empty footer is not chrome, it is a gap.

lib/App/FuguWeb/Page.pod view on Meta::CPAN

including the slash and the ampersand that a C<sed> template could not
take.

Two separators are not ASCII: an em dash between the page title and the
site name, and a middle dot between navigation entries. Both are byte
constants. No file in the namespace carries C<use utf8>, and
L<Fugu::File> reads and writes bytes, so those bytes reach the output
unchanged.

The title and every navigation label go through
L<App::FuguWeb/escape_html>.

=head1 METHODS

=head2 new

    App::FuguWeb::Page->new(config => $config)
    App::FuguWeb::Page->new(config => $config, base => '../')

C<config> is an L<App::FuguWeb::Config> and is required.

t/fuguweb/index.t view on Meta::CPAN


	# A browser reads a relative URL whose first segment holds a
	# colon as a scheme, so every local link keeps its './'.
	my @hrefs = $body =~ m{href="([^"]+)"}g;
	my @bad =
	    grep { /^[A-Za-z][A-Za-z0-9.+-]*:/ && !m{^https?:} } @hrefs;
	is( scalar @bad, 0, 'no link reads as a URL scheme' )
	    or diag "offenders: @bad";
};

subtest 'a page name reaches the href escaped' => sub {
	my $root = build_root($RC);

	# A quote in a manual name would end the attribute early and
	# everything after it would become markup.
	open my $fh, '>', "$root/man/tool/od\"d.1"
	    or plan skip_all => 'this filesystem takes no quote in a name';
	print {$fh} ".Sh NAME\n.Nd a quoted name\n";
	close $fh;

	my $config =
	    App::FuguWeb::Config->load( root => $root, error => \my $reason );
	ok( $config, 'the description loads' ) or diag $reason;

	my $body = App::FuguWeb::Index->new( config => $config )->body;
	like( $body, qr/href="\.\/od&quot;d\.1\.html"/,
		'the quote is escaped in the attribute' );
	unlike( $body, qr/href="\.\/od"d/, 'and the attribute is not broken' );
};

subtest 'a description is escaped' => sub {
	my $root = build_root($RC);
	open my $fh, '>', "$root/man/tool/tool.1"
	    or die "Cannot rewrite the source: $!";
	print {$fh} ".Sh NAME\n.Nd a & b < c\n";
	close $fh;

	my $config =
	    App::FuguWeb::Config->load( root => $root, error => \my $reason );
	ok( $config, 'the description loads' ) or diag $reason;

t/fuguweb/page.t view on Meta::CPAN

	my $html = render( $page, 'Install', '' );

	like( $html, qr/<title>Install \xe2\x80\x94 Example<\/title>/,
		'an em dash separates the title from the site' );
	like( $html, qr/<\/a> \xc2\xb7\n/,
		'a middle dot separates two navigation entries' );
	unlike( $html, qr/<\/a> \xc2\xb7\n<\/nav>/,
		'the last entry carries no separator' );
};

subtest 'the title and the labels are escaped' => sub {
	my $config = site( <<'RC' );
site = A & B

nav "index.html" {
	label = <Home>
}
RC
	my $page = App::FuguWeb::Page->new( config => $config );
	my $html = render( $page, 'Tags < & >', '' );

	like( $html, qr/<title>Tags &lt; &amp; &gt; /,
		'the title is escaped' );
	like( $html, qr/&amp; B<\/title>/, 'the site name is escaped' );
	like( $html, qr/>&lt;Home&gt;<\/a>/, 'a navigation label is escaped' );

	# The shell chrome that this replaced substituted the title with
	# sed. A slash ended the substitution and an ampersand meant
	# "the whole match", so neither could ever reach a page.
	$html = render( $page, 'openhapd.conf(5) / 8', '' );
	like( $html, qr{<title>openhapd\.conf\(5\) / 8 },
		'a title may hold a slash' );
};

subtest 'a value that reaches an attribute is escaped' => sub {
	my $config = site( <<'RC' );
site  = Example
lang  = en" onload="x
entry = index.html?a&b

nav "search.html?q=1&r=2" {
	label = Search
}
RC
	my $page = App::FuguWeb::Page->new( config => $config );
	my $html = render( $page, 'Install', '' );

	# A quote in a value would end the attribute early, and
	# everything after it would become markup.
	like( $html, qr/<html lang="en&quot; onload=&quot;x">/,
		'the lang attribute is escaped' );
	unlike( $html, qr/onload="x"/, 'no attribute was injected' );

	# An ampersand is not markup, but it is not valid in an
	# attribute either, and the same escape covers both.
	like( $html, qr{href="index\.html\?a&amp;b"},
		'the header link is escaped' );
	like( $html, qr{href="search\.html\?q=1&amp;r=2"},
		'a navigation href is escaped' );
};

subtest 'the footer fragment is optional' => sub {
	my $page = App::FuguWeb::Page->new( config => site($RC) );
	my $html = render( $page, 'Install', '' );
	unlike( $html, qr/<footer>/, 'no fragment, no footer element' );
	like( $html, qr/<\/main>\n<\/body>/, 'and no rule before one' );

	$page = App::FuguWeb::Page->new(
		config => site( $RC, 'footer.body.html' => "<p>ISC.</p>\n" ) );

t/fuguweb/rotate.t view on Meta::CPAN

		'the mint fails' );
	like( $rotate->error, qr/the organization word/,
		'and the reason names the word' );
};

subtest 'the key directory word names one directory' => sub {
	my $root = _site();

	# WEB-ROTATE-21. A word that held a solidus would write the
	# key outside the source directory.
	for my $dir ( '../escaped', 'a/b', '..', '.' ) {
		my $reason;
		my $config = App::FuguWeb::Config->load( root => $root,
			error => \$reason )
		    or die "load: $reason\n";
		my $rotate = App::FuguWeb::Rotate->new(
			config    => $config,
			org       => $ORG,
			dir       => $dir,
			bootstrap => 1,
		);

t/fuguweb/rotate.t view on Meta::CPAN

			!$rotate->mint(
				purpose => 'root',
				secret  => "$root/k.sec"
			),
			"the word $dir fails the mint"
		);
		like( $rotate->error, qr/is not one name/,
			'and the reason says why' );
	}

	ok( !-e "$root/escaped", 'and no directory stands outside the source' );
};

# WEB-ROTATE-21. The directory word selects the key directory that a
# step writes. A description with one keys block needs none, and every
# subtest above reads that.
subtest 'a step names the key directory that it writes' => sub {
	my $root = _keyed();

	# The description holds no block of the second directory yet,
	# so the mint takes the intent, the name, the organization word

t/fuguweb/rotate.t view on Meta::CPAN

	) or diag( $asked->error );
	ok( -f "$root/web/other/other-1-root.pub",
		'and the key lands in the new directory' );
};

# WEB-ROTATE-21 and WEB-KEYS-29. Every verb holds the word to one
# directory below the source directory.
subtest 'a promote names one key directory' => sub {
	my $root = _keyed();

	for my $dir ( '../escaped', 'a/b', '..', '.' ) {
		my $reason;
		my $config = App::FuguWeb::Config->load( root => $root,
			error => \$reason )
		    or die "load: $reason\n";
		my $rotate = App::FuguWeb::Rotate->new(
			config => $config,
			dir    => $dir,
		);
		ok(
			!$rotate->promote(
				purpose  => 'release',
				retiring => "$root/rel1.sec"
			),
			"the word $dir fails the promote"
		);
		like( $rotate->error, qr/is not one name/,
			'and the reason says why' );
	}

	ok( !-e "$root/escaped", 'and no directory stands outside the source' );
};

subtest 'an absent signify takes the code of a missing tool' => sub {
	my $root = _site();

	# WEB-ROTATE-17. A caller tells a tool that it must install
	# from a step that failed, as it does for a renderer.
	my ( $exit, $out, $err ) = do {
		local $ENV{PATH} = '/nonexistent';
		_run(

( run in 2.749 seconds using v1.01-cache-2.11-cpan-54e63673c56 )