From fef14233a620e44984fa88dfddf403e6cd2d4f20 Mon Sep 17 00:00:00 2001 From: mdw Date: Tue, 24 Aug 1999 12:15:34 +0000 Subject: [PATCH] Properly sanitize CGI arguments (like `gtk+'). --- perl/SWCGI.pm | 17 +++++++++++++++-- perl/SWInfo.pm | 10 ++++++---- perl/SWList.pm | 8 ++++++-- perl/SWMan.pm | 10 +++++++--- 4 files changed, 34 insertions(+), 11 deletions(-) diff --git a/perl/SWCGI.pm b/perl/SWCGI.pm index 2e28455..d092a0f 100644 --- a/perl/SWCGI.pm +++ b/perl/SWCGI.pm @@ -1,6 +1,6 @@ # -*-perl-*- # -# $Id: SWCGI.pm,v 1.1 1999/07/30 18:46:37 mdw Exp $ +# $Id: SWCGI.pm,v 1.2 1999/08/24 12:15:33 mdw Exp $ # # Miscellaneous CGI support functions # @@ -28,6 +28,9 @@ #----- Revision history ----------------------------------------------------- # # $Log: SWCGI.pm,v $ +# Revision 1.2 1999/08/24 12:15:33 mdw +# Properly sanitize CGI arguments (like `gtk+'). +# # Revision 1.1 1999/07/30 18:46:37 mdw # New CGI script for browsing installed software and documentation. # @@ -41,7 +44,7 @@ use SWConfig; @ISA = qw(Exporter); @EXPORT = qw(barf %Q $ref); -@EXPORT_OK = qw(read); +@EXPORT_OK = qw(read sanitize); %EXPORT_TAGS = (layout => [qw(header footer)], debug => [qw(dumphash)]); @@ -130,6 +133,16 @@ sub dumphash(\%) { print "\n"; } +#----- Sanitizing links ----------------------------------------------------- + +sub sanitize($) { + my ($l) = @_; + $l =~ s/[+&%=]/"%" . sprintf("%02x", ord($&))/eg; + $l =~ tr/ /+/; + $l =~ s/[^!-~]/"%" . sprintf("%02x", ord($&))/eg; + return $l; +} + #----- Argument reading ----------------------------------------------------- %Q = (); diff --git a/perl/SWInfo.pm b/perl/SWInfo.pm index 42c4119..c4cf7bb 100644 --- a/perl/SWInfo.pm +++ b/perl/SWInfo.pm @@ -1,6 +1,6 @@ # -*-perl-*- # -# $Id: SWInfo.pm,v 1.3 1999/08/19 12:11:10 mdw Exp $ +# $Id: SWInfo.pm,v 1.4 1999/08/24 12:15:33 mdw Exp $ # # Read and output GNU Info files # @@ -28,6 +28,9 @@ #----- Revision history ----------------------------------------------------- # # $Log: SWInfo.pm,v $ +# Revision 1.4 1999/08/24 12:15:33 mdw +# Properly sanitize CGI arguments (like `gtk+'). +# # Revision 1.3 1999/08/19 12:11:10 mdw # More improvements to URL recognizer. # @@ -80,11 +83,10 @@ sub subst($$$) { # --- Transform it into something that won't get mangled --- - $node =~ s/[+&=%]|[^ -~]/sprintf("%%%02x", ord($&))/eg; - $node =~ tr/ /+/; + $node = SWCGI::sanitize($node); ($dir = $i->{dir}) =~ s:$C{prefix}/info/?::; - $dir = "&dir=$dir" if $dir; + $dir = "&dir=" . SWCGI::sanitize($dir) if $dir; return "$oref$tail"; } diff --git a/perl/SWList.pm b/perl/SWList.pm index e2e83be..579665b 100644 --- a/perl/SWList.pm +++ b/perl/SWList.pm @@ -1,6 +1,6 @@ # -*-perl-*- # -# $Id: SWList.pm,v 1.1 1999/07/30 18:46:37 mdw Exp $ +# $Id: SWList.pm,v 1.2 1999/08/24 12:15:34 mdw Exp $ # # Create the main list of installed packages # @@ -28,6 +28,9 @@ #----- Revision history ----------------------------------------------------- # # $Log: SWList.pm,v $ +# Revision 1.2 1999/08/24 12:15:34 mdw +# Properly sanitize CGI arguments (like `gtk+'). +# # Revision 1.1 1999/07/30 18:46:37 mdw # New CGI script for browsing installed software and documentation. # @@ -197,7 +200,8 @@ EOF # --- If the documentation file exists, put a link in --- if (-r "$C{doc}/$pkg") { - print(" Yes\n"); + printf(" Yes\n", + SWCGI::sanitize($pkg)); } else { print(" No\n"); } diff --git a/perl/SWMan.pm b/perl/SWMan.pm index e799148..4a48eb5 100644 --- a/perl/SWMan.pm +++ b/perl/SWMan.pm @@ -1,6 +1,6 @@ # -*-perl-*- # -# $Id: SWMan.pm,v 1.3 1999/08/19 12:11:10 mdw Exp $ +# $Id: SWMan.pm,v 1.4 1999/08/24 12:15:34 mdw Exp $ # # Display and other fiddling of manual pages # @@ -28,6 +28,9 @@ #----- Revision history ----------------------------------------------------- # # $Log: SWMan.pm,v $ +# Revision 1.4 1999/08/24 12:15:34 mdw +# Properly sanitize CGI arguments (like `gtk+'). +# # Revision 1.3 1999/08/19 12:11:10 mdw # More improvements to URL recognizer. # @@ -106,8 +109,9 @@ sub check($$) { sub subst($$$) { my ($s, $n, $sec) = @_; check($n, $sec) and - return "$s"; - return "$s"; + return sprintf("$s", + SWCGI::sanitize($n)); + return $s; } # --- @urlsubst(URL, STRING)@ --- -- 2.11.0