3535use utf8;
3636
3737use Cwd qw( abs_path)
38- use File::Basename qw( basename)
38+ use File::Basename qw( basename dirname )
3939use File::Find;
4040use File::Spec;
41+ use File::Temp qw( tempfile)
42+ use Getopt::Long qw( GetOptions)
4143use Time::Local qw( timegm)
4244
4345my $script_dir = ( File::Spec-> splitpath($0 ) )[1];
5052$feeds_dir = File::Spec-> catdir( $root_dir , ' feeds'
5153$articles_dir = File::Spec-> catdir( $root_dir , ' articles'
5254
55+ # Optional deployment base URL. When empty (the default) links stay
56+ # root-relative so a single feed works on every mirror (HTTPS, Tor,
57+ # I2P). GUIDs always stay relative and therefore stable.
58+ my $base_url = ' '
59+ GetOptions( ' base-url=s' => \$base_url )
60+ or die " Usage: $0 [--base-url https://example.org]\n "
61+ $base_url =~ s {} {} $ base_url;
62+
5363binmode STDOUT, ':encoding(UTF-8)';
5464binmode STDERR, ':encoding(UTF-8)';
5565
@@ -68,10 +78,45 @@ sub read_file {
6878
6979sub write_file {
7080 my ( $path , $content ) = @_ ;
71- open my $fh , ' >:encoding(UTF-8)' $path
72- or die_tool(" Could not write $path : $! "
73- print {$fh } $content ;
74- close $fh ;
81+
82+ # Atomic, same-directory replacement: readers only ever observe the
83+ # old or the new file, never a partial write.
84+ my $dir = dirname($path );
85+ my $mode ;
86+ if ( -e $path ) {
87+ $mode = ( stat($path ) )[2] & 07777;
88+ }
89+ else {
90+ my $mask = umask;
91+ umask $mask ;
92+ $mode = 0666 & ~$mask ;
93+ }
94+
95+ my ( $fh , $tmp ) = tempfile( '.tmp-XXXXXX', DIR => $dir , UNLINK => 0 );
96+ binmode $fh , ':encoding(UTF-8)';
97+
98+ if ( !print {$fh } $content ) {
99+ my $err = $! ;
100+ close $fh ;
101+ unlink $tmp ;
102+ die_tool(" Could not write $path : $err " );
103+ }
104+ if ( !close $fh ) {
105+ my $err = $! ;
106+ unlink $tmp ;
107+ die_tool(" Could not close $path : $err " );
108+ }
109+ if ( defined $mode && !chmod $mode , $tmp ) {
110+ my $err = $! ;
111+ unlink $tmp ;
112+ die_tool(" Could not set permissions on $path : $err " );
113+ }
114+ if ( !rename $tmp , $path ) {
115+ my $err = $! ;
116+ unlink $tmp ;
117+ die_tool(" Could not replace $path : $err " );
118+ }
119+ return 1;
75120}
76121
77122sub xml_escape {
@@ -83,15 +128,38 @@ sub xml_escape {
83128 return $text ;
84129}
85130
86- sub decode_html_quotes {
131+ sub decode_entities {
87132 my ($text ) = @_ ;
88133 return '' unless defined $text ;
89- $text =~ s // "/ gi
90- $text =~ s // "/ g
91- $text =~ s // "/ gi
92- $text =~ s // '/ gi
93- $text =~ s // '/ g
94- $text =~ s // '/ gi
134+
135+ # Decode the common named entities plus numeric references so that
136+ # HTML-sourced text can be safely re-encoded as XML without double
137+ # encoding. Unknown entities are left untouched.
138+ my %named = (
139+ amp => '&',
140+ lt => '<',
141+ gt => '>',
142+ quot => '" ' ,
143+ apos => "' " ,
144+ nbsp => " \x{a0 }" ,
145+ );
146+
147+ $text =~ s{&(\# [0-9]+|\# [xX][0-9A-Fa-f]+|[A-Za-z][A-Za-z0-9]*);}{
148+ my $e = $1 ;
149+ if ( $e =~ /^\# ([0-9]+)$/ ) {
150+ $1 <= 0x10FFFF ? chr($1 ) : " &$e ;" ;
151+ }
152+ elsif ( $e =~ /^\# [xX]([0-9A-Fa-f]+)$/ ) {
153+ hex($1 ) <= 0x10FFFF ? chr( hex $1 ) : " &$e ;" ;
154+ }
155+ elsif ( exists $named {$e } ) {
156+ $named {$e };
157+ }
158+ else {
159+ " &$e ;" ;
160+ }
161+ }ge;
162+
95163 return $text ;
96164}
97165
@@ -208,6 +276,7 @@ sub extract_metadata {
208276 my ($title ) = $content_scope =~ / <h[12][^>]*>\s *(.*?)\s *<\/ h[12]>/is
209277 $title //= ' Untitled'
210278 $title = strip_tags_and_trim($title );
279+ $title = decode_entities($title );
211280
212281 my ($desc ) = $html =~ / <meta[^>]*\b name\s *=\s *["']
213282 description["'][^>]*\b content
@@ -224,9 +293,8 @@ sub extract_metadata {
224293 ($desc ) = $content_scope =~ / <p[^>]*>\s *(.*?)\s *<\/ p>/is
225294 $desc //= ' '
226295 }
227- $desc = decode_html_quotes($desc );
228- $desc = strip_tags_and_trim($desc );
229296 $desc = normalize_summary($desc );
297+ $desc = decode_entities($desc );
230298
231299 my ($iso ) = $html =~ / <time[^>]*\s datetime\s *=\s *"([^"]+)"/i
232300 $iso //= ( $html =~ / <time[^>]*\s datetime\s *=\s *'([^']+)'/i
@@ -255,7 +323,10 @@ sub collect_articles {
255323 wanted => sub {
256324 return unless -f $_ ;
257325 return unless / \. html$ /i
258- return if $_ eq ' index.html'
326+
327+ # With no_chdir => 1, $_ is the full path, so match the
328+ # basename rather than comparing to 'index.html'.
329+ return if m {\. html$} i
259330
260331 my $path = $File::Find::name ;
261332 my $meta = extract_metadata($path );
@@ -273,6 +344,15 @@ sub collect_articles {
273344 return \@rows ;
274345}
275346
347+ sub abs_url {
348+ my ($path ) = @_ ;
349+ return $path if !length $base_url ;
350+ return $path if $path =~ m {} i
351+ return " $base_url /" if $path eq ' /'
352+ return $path if $path !~ m {}
353+ return " $base_url$path "
354+ }
355+
276356sub rebuild_feed_file {
277357 my ( $feed_path , $lang , $rows ) = @_ ;
278358 my $xml = read_file($feed_path );
@@ -283,16 +363,18 @@ sub rebuild_feed_file {
283363 $channel_link = as_root_relative_url($channel_link );
284364 $channel_link = ' /'
285365 unless length $channel_link ;
366+ $channel_link = abs_url($channel_link );
286367 my ($channel_desc ) = $xml =~ m {} s
287368 $channel_desc //= ' '
288369 my $feed_name = basename($feed_path );
289- my $feed_url = " /feeds/$feed_name "
370+ my $feed_url = abs_url( " /feeds/$feed_name " ) ;
290371
291372 my $items = ' '
292373 for my $r (@$rows ) {
293374 next if $r -> {lang } ne $lang ;
294375 my $pub = format_pubdate( $r -> {epoch } );
295- my $article_url = " /articles/$r ->{slug}.html"
376+ my $rel_url = " /articles/$r ->{slug}.html"
377+ my $article_url = abs_url($rel_url );
296378 $items .= join ' '
297379 " <item>\n "
298380 " <title>"
@@ -303,7 +385,7 @@ sub rebuild_feed_file {
303385 xml_escape( $r -> {desc } ),
304386 " </description>\n "
305387 " <pubDate>$pub </pubDate>\n "
306- " <guid" " isPermaLink=\" false\" >" " $article_url </guid>\n "
388+ " <guid" " isPermaLink=\" false\" >" " $rel_url </guid>\n "
307389 " </item>\n "
308390 }
309391
@@ -319,9 +401,9 @@ sub rebuild_feed_file {
319401 qq( <?xml version="1.0" encoding="UTF-8"?>\n )
320402 qq( <rss xmlns:atom="http://www.w3.org/) qq( 2005/Atom" version="2.0">\n )
321403 qq( <channel>\n )
322- qq( <title>) . xml_escape( $channel_title ) . qq( </title>\n )
404+ qq( <title>$channel_title </title>\n )
323405 qq( <link>$channel_link </link>\n )
324- qq( <description>) . xml_escape( $channel_desc ) . qq( </description>\n )
406+ qq( <description>$channel_desc </description>\n )
325407 qq( <lastBuildDate>$last_build ) qq( </lastBuildDate>\n )
326408 qq( <atom:link href="$feed_url ")
327409 . qq( rel="self")
0 commit comments