[Libguestfs] [PATCH 2/3] podwrapper: Generate consistent WARNING sections (RHBZ#1293527).

[Richard W.M. Jones]

---
 podwrapper.pl.in | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 73 insertions(+), 2 deletions(-)

diff --git a/podwrapper.pl.in b/podwrapper.pl.in
index 37e3e84..fd7a502 100755
--- a/podwrapper.pl.in
+++ b/podwrapper.pl.in
@@ -47,6 +47,7 @@ podwrapper.pl - Generate libguestfs documentation from POD input files
            --man virt-foo.1 \
            --html $(top_builddir)/website/virt-foo.1.html \
            --license GPLv2+ \
+           --warning general \
            $<
          touch $@
  
@@ -182,6 +183,31 @@ patterns, in fact you can use any string as the pattern.
 
 =cut
 
+my $warning = "not-set";
+
+=item B<--warning general>
+
+=item B<--warning ro-option>
+
+Add a standard warning section near the top of the manual page,
+warning the user not to use the tool in write mode or concurrently.
+
+There are two variations of the warning: The I<--warning ro-option>
+variation should be used with tools such as L<guestfish(1)> which have
+an I<--ro> option.  The I<--warning general> variation should be used
+with other tools that open the disk image for writes, with no
+read-only option.
+
+=item B<--warning custom>
+
+Use I<--warning custom> if there is already a warning section in the
+manual page.
+
+=item B<--warning safe>
+
+Use I<--warning safe> for tools which are safe, ie. only open disk
+images in read-only mode, or just don't need a warning section.
+
 =back
 
 =cut
@@ -200,7 +226,8 @@ GetOptions ("help|?" => \$help,
             "section=s" => \$section,
             "strict-checks!" => \$strict_checks,
             "text=s" => \$text,
-            "verbatim=s" => \@verbatims
+            "verbatim=s" => \@verbatims,
+            "warning=s" => \$warning,
     ) or pod2usage (2);
 pod2usage (1) if $help;
 
@@ -221,6 +248,13 @@ $section = 1 unless defined $section;
 # Is it a user command line tool?
 my $cli_tool = $section == 1 && $name !~ /^guestfs-/;
 
+# Warning parameter is mandatory for user tools in section 1.
+if ($strict_checks && $cli_tool) {
+    die "$progname: $input: missing argument: --warning parameter is missing or invalid\n"
+        unless $warning eq "general" || $warning eq "ro-option" ||
+               $warning eq "custom" || $warning eq "safe";
+}
+
 # Note that these @...@ are substituted by ./configure.
 my $abs_top_srcdir = "@abs_top_srcdir@";
 my $abs_top_builddir = "@abs_top_builddir@";
@@ -266,6 +300,7 @@ my $release = "$package_name-$package_version";
 #print "name=$name\n";
 #print "section=$section\n";
 #print "date=$date\n";
+#print "warning=$warning\n";
 
 # Read the input.
 my $content = read_whole_file ($input);
@@ -318,9 +353,18 @@ if ($strict_checks) {
     die "$progname: $input: GPL/LGPL should be specified using the --license parameter, not included in the POD file\n"
         if $content =~ /^This program is free software/ ||
         $content =~ /^This library is free software/;
+    if ($warning eq "general" || $warning eq "ro-option" ||
+        $warning eq "safe") {
+        die "$progname: $input: WARNING is now added automatically using the --warning parameter\n"
+            if $content =~ /^=head1 WARNING/m
+    }
+    elsif ($warning eq "custom") {
+        die "$progname: $input: missing WARNING section\n"
+            unless $content =~ /^=head1 WARNING/m;
+    }
 }
 
-# Add standard LICENSE and BUGS sections.
+# Add standard LICENSE, BUGS and WARNING sections.
 my $LGPLv2plus =
 "This library is free software; you can redistribute it and/or modify it
 under the terms of the GNU Lesser General Public License as published
@@ -393,6 +437,25 @@ output into the bug report.
 \=back
 ";
 
+my $warning_general =
+"Using C<$name>
+on live virtual machines, or concurrently with other
+disk editing tools, can be dangerous, potentially causing disk
+corruption.  The virtual machine must be shut down before you use this
+command, and disk images must not be edited concurrently.";
+
+my $warning_ro_option =
+"Using C<$name> in write mode
+on live virtual machines, or concurrently with other
+disk editing tools, can be dangerous, potentially causing disk
+corruption.  The virtual machine must be shut down before you use this
+command, and disk images must not be edited concurrently.
+
+Use the I<--ro> (read-only) option to use C<$name> safely if the disk
+image or virtual machine might be live.  You may see strange or
+inconsistent results if running concurrently with other changes, but
+with this option you won't risk disk corruption.";
+
 $content .= "\n\n=head1 LICENSE\n\n";
 
 foreach (@licenses) {
@@ -412,6 +475,14 @@ foreach (@licenses) {
 
 $content .= "\n\n$reporting_bugs";
 
+if ($warning eq "general") {
+    $content =~ s/^=head1 DESCRIPTION/=head1 WARNING\n\n$warning_general\n\n=head1 DESCRIPTION/m or die;
+}
+elsif ($warning eq "ro-option") {
+    $content =~ s/^=head1 DESCRIPTION/=head1 WARNING\n\n$warning_ro_option\n\n=head1 DESCRIPTION/m or die;
+}
+# else do nothing for $warning "custom", "safe" or "not-set"
+
 # Output man page.
 SUBMAN: {
     package Podwrapper::Man;
-- 
2.5.0