CheckRFC: https-links now will be matched

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

diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm
index ddde67f6a569d163698514f4e6278d806739b5ea..639f77fd2de7b3e8c120b0e2b49b4f2dacb9f814 100644 (file)
--- a/selfforum-cgi/shared/CheckRFC.pm
+++ b/selfforum-cgi/shared/CheckRFC.pm
@@ -99,6 +99,8 @@ sub is_email ($;$) {
 
   # remove nested comments
   1 while ($string =~ s/\([^()]*\)//g);
+  #$string =~ s/^\s+//;
+  #$string =~ s/\s+$//;
 
   return ($string =~ /^$email[0]$/) unless $strict;
 
@@ -141,7 +143,7 @@ BEGIN {
 
   @email = ();
   for $domain (
-    qq< $sub_domain (?: $Period $X $sub_domain )+ >,
+    qq< $sub_domain (?: $Period $X $sub_domain )* $Period [A-Za-z][A-Za-z][A-Za-z]?[A-Za-z]? >,
     qq< $sub_domain (?: $Period $X $sub_domain )* >
   ) {
     my $route       = qq< \@ $X $domain (?: , $X \@ $X $domain )* : $X >;
@@ -226,8 +228,8 @@ BEGIN {
   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*)";