Initial release

[selfforum.git] / selfforum-cgi / shared / CheckRFC.pm

diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm
index cb9a616e7d2fa2fe3afce9b5593a8b6867b9c92c..6f8fa49d61bfc5bc92f2b4c6a429b2667021cb1c 100644 (file)
--- a/selfforum-cgi/shared/CheckRFC.pm
+++ b/selfforum-cgi/shared/CheckRFC.pm
@@ -177,22 +177,22 @@ BEGIN {
   # credits to an unknown(?) programmer ;)
   # modified by n.d.p.
 
   # credits to an unknown(?) programmer ;)
   # modified by n.d.p.
 

-  my $lowalpha       =  '(?:[a-z])';
-  my $hialpha        =  '(?:[A-Z])';
-  my $alpha          =  "(?:$lowalpha|$hialpha)";
-  my $digit          =  '(?:\d)';
-  my $safe           =  '(?:[$_.+-])';
-  my $extra          =  '(?:[!*\'(),])';
-  my $national       =  '(?:[{}|\\\\^~\[\]`])';
-  my $punctuation    =  '(?:[<>#%"])';
-  my $reserved       =  '(?:[;/?:@&=])';
-  my $hex            =  '(?:[\dA-Fa-f])';
+  my $lowalpha       =  '[a-z]';
+  my $hialpha        =  '[A-Z]';
+  my $alpha          =  '[a-zA-Z]';
+  my $digit          =  '\d';
+  my $safe           =  '[$_.+-]';
+  my $extra          =  '[!*\'(),]';
+  my $national       =  '[{}|\\\\^~\[\]`]';
+  my $punctuation    =  '[<>#%"]';
+  my $reserved       =  '[;/?:@&=]';
+  my $hex            =  '[\dA-Fa-f]';

   my $escape         =  "(?:%$hex$hex)";
   my $escape         =  "(?:%$hex$hex)";

-  my $unreserved     =  "(?:$alpha|$digit|$safe|$extra)";
+  my $unreserved     =  '[{}|\\\\^~\[\]`a-zA-Z\d$_.+-]';    #"(?:$alpha|$digit|$safe|$extra)";

   my $uchar          =  "(?:$unreserved|$escape)";
   my $xchar          =  "(?:$unreserved|$escape|$reserved)";
   my $digits         =  '(?:\d+)';
   my $uchar          =  "(?:$unreserved|$escape)";
   my $xchar          =  "(?:$unreserved|$escape|$reserved)";
   my $digits         =  '(?:\d+)';

-  my $alphadigit     =  "(?:$alpha|\\d)";
+  my $alphadigit     =  '[a-zA-Z\d]';                       #"(?:$alpha|$digit)";

 
   # URL schemeparts for ip based protocols:
   my $urlpath        =  "(?:$xchar*)";
 
   # URL schemeparts for ip based protocols:
   my $urlpath        =  "(?:$xchar*)";


@@ -228,8 +228,8 @@ BEGIN {
   my $hsegment       =  "(?:(?:$httpuchar|[;:\@&=~])*)";
   my $search         =  "(?:(?:$httpuchar|[;:\@&=~])*)";
   my $hpath          =  "(?:$hsegment(?:/$hsegment)*)";
   my $hsegment       =  "(?:(?:$httpuchar|[;:\@&=~])*)";
   my $search         =  "(?:(?:$httpuchar|[;:\@&=~])*)";
   my $hpath          =  "(?:$hsegment(?:/$hsegment)*)";

-  my $httpurl        =  "(?:http://$hostport(?:/$hpath(?:\\?$search)?)?(?:#$xchar*)?)";
-  my $strict_httpurl =  "(?:http://$hostport(?:/$hpath(?:\\?$search)?)?)";
+  my $httpurl        =  "(?:https?://$hostport(?:/$hpath(?:\\?$search)?)?(?:#$xchar*)?)";
+  my $strict_httpurl =  "(?:https?://$hostport(?:/$hpath(?:\\?$search)?)?)";

 
   # GOPHER (see also RFC1436)
   my $gopher_plus    =  "(?:$xchar*)";
 
   # GOPHER (see also RFC1436)
   my $gopher_plus    =  "(?:$xchar*)";