X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/489e7846289d4fb66eb4b9fab0fed4af719b98ee..75f82718d85387517290bb1a5918980aa656bb1f:/selfforum-cgi/shared/CheckRFC.pm?ds=inline diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm index ddde67f..6f8fa49 100644 --- 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 >; @@ -175,22 +177,22 @@ BEGIN { # 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 $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 $alphadigit = "(?:$alpha|\\d)"; + my $alphadigit = '[a-zA-Z\d]'; #"(?:$alpha|$digit)"; # URL schemeparts for ip based protocols: my $urlpath = "(?:$xchar*)"; @@ -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*)";