fixed some bugs

diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm
index ddde67f6a569d163698514f4e6278d806739b5ea..1441038d5f2338740194355baf0f4363375a9b57 100644 (file)
--- a/selfforum-cgi/shared/CheckRFC.pm
+++ b/selfforum-cgi/shared/CheckRFC.pm
@@ -141,7 +141,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 >;

diff --git a/selfforum-cgi/shared/Encode/Posting.pm b/selfforum-cgi/shared/Encode/Posting.pm
index e35e6486e4d7e6deebec26c7acb6f2c0fa15453f..ffafbf1c0f3aa848f1d43163c615acbe21a800ba 100644 (file)
--- a/selfforum-cgi/shared/Encode/Posting.pm
+++ b/selfforum-cgi/shared/Encode/Posting.pm
@@ -60,7 +60,7 @@ sub encoded_body ($;$) {
   my $params = shift;
 
   $posting =~ s/\015\012|\015|\012/\n/g; # normalize newlines
-  $posting =~ s/[^\S\n]$//gm;            # kill whitespaces at the end of all lines
+  $posting =~ s/[^\S\n]+$//gm;           # kill whitespaces at the end of all lines
   $posting =~ s/\s+$//;                  # kill whitespaces (newlines) at the end of the string (text)
 
   # check the special syntaxes:
@@ -73,7 +73,7 @@ sub encoded_body ($;$) {
   my @links = grep {
        is_URL ( $_ -> [1] => ':ALL')
     or is_URL (($_ -> [1] =~ /^[Vv][Ii][Ee][Ww]-[Ss][Oo][Uu][Rr][Cc][Ee]:(.+)/)[0] || '' => 'http')
-    or (  $_ -> [1] =~ m<^\.?\.?/(?!/)|\?>
+    or (  $_ -> [1] =~ m<^(?:\.?\.?/(?!/)|\?)>
       and is_URL (rel_uri ($_ -> [1], $base) => 'http'))
   } @rawlinks;
 
@@ -83,7 +83,7 @@ sub encoded_body ($;$) {
   push @rawimages => [$1 => $2] while ($posting =~ /\[([Ii][Mm][Aa][Gg][Ee]):\s*([^\]\s]+)\s*\]/g);
   my @images = grep {
        is_URL ($_ -> [1] => 'strict_http')
-    or (  $_ -> [1] =~ m<^\.?\.?/(?!/)|\?>
+    or (  $_ -> [1] =~ m<^(?:\.?\.?/(?!/)|\?)>
       and is_URL (rel_uri ($_ -> [1], $base) => 'http'))
   } @rawimages;
 
@@ -93,8 +93,7 @@ sub encoded_body ($;$) {
   push @rawiframes => [$1 => $2] while ($posting =~ /\[([Ii][Ff][Rr][Aa][Mm][Ee]):\s*([^\]\s]+)\s*\]/g);
   my @iframes = grep {
        is_URL ($_ -> [1] => 'http')
-    or is_URL (($_ -> [1] =~ /^[Vv][Ii][Ee][Ww]-[Ss][Oo][Uu][Rr][Cc][Ee]:(.+)/)[0] || '' => 'http')
-    or (  $_ -> [1] =~ m<^\.?\.?/(?!/)|\?>
+    or (  $_ -> [1] =~ m<^(?:\.?\.?/(?!/)|\?)>
       and is_URL (rel_uri ($_ -> [1], $base) => 'http'))
   } @rawiframes;
 

diff --git a/selfforum-cgi/shared/Posting/_lib.pm b/selfforum-cgi/shared/Posting/_lib.pm
index 630a1e193832c4fc481f3900bc49a25e6114a0f4..94f6af4e8d38bc639ed9ff96d427c5f2ebf89883 100644 (file)
--- a/selfforum-cgi/shared/Posting/_lib.pm
+++ b/selfforum-cgi/shared/Posting/_lib.pm
@@ -75,6 +75,7 @@ sub create_message ($$) {
 
   my $header = $xml -> createElement ('Header');
   my $author = $xml -> createElement ('Author');
+  $header  -> appendChild ($author);
 
   my @may = (
     ['name'     => 'Name'        => $author],
@@ -104,7 +105,6 @@ sub create_message ($$) {
   my $date = $xml -> createElement ('Date');
   $date -> setAttribute ('longSec'=> $par -> {time});
 
-  $header  -> appendChild ($author);
   $header  -> appendChild ($date);
   $message -> appendChild ($header);
 

diff --git a/selfforum-cgi/user/fo_posting.pl b/selfforum-cgi/user/fo_posting.pl
index c78cab7d6e440becb20f9d2a06c5df6bf8f48bd7..a2d756edab911086609d418ad0bf95dca29a6b88 100644 (file)
--- a/selfforum-cgi/user/fo_posting.pl
+++ b/selfforum-cgi/user/fo_posting.pl
@@ -21,17 +21,17 @@ use vars qw(
 # locate the script
 #
 BEGIN {
-#  my $null = $0; $null =~ s/\\/\//g; # for win :-(
-#  $Bin     = ($null =~ /^(.*)\/.*$/)? $1 : '.';
-#  $Shared  = "$Bin/../shared";
-#  $Config  = "$Bin/config";
-#  $Script  = ($null =~ /^.*\/(.*)$/)? $1 : $null;
-
-  my $null = $0; #$null =~ s/\\/\//g; # for win :-(
+  my $null = $0; $null =~ s/\\/\//g; # for win :-(
   $Bin     = ($null =~ /^(.*)\/.*$/)? $1 : '.';
-  $Config  = "$Bin/../../../cgi-config/devforum";
-  $Shared  = "$Bin/../../../cgi-shared";
+  $Shared  = "$Bin/../shared";
+  $Config  = "$Bin/config";
   $Script  = ($null =~ /^.*\/(.*)$/)? $1 : $null;
+
+#  my $null = $0; #$null =~ s/\\/\//g; # for win :-(
+#  $Bin     = ($null =~ /^(.*)\/.*$/)? $1 : '.';
+#  $Config  = "$Bin/../../../cgi-config/devforum";
+#  $Shared  = "$Bin/../../../cgi-shared";
+#  $Script  = ($null =~ /^.*\/(.*)$/)? $1 : $null;
 }
 
 use lib "$Shared";

diff --git a/selfforum-cgi/user/fo_view.pl b/selfforum-cgi/user/fo_view.pl
index 37260e3278e766ab0073c1687877d0caec6eb0f0..7470dc7be958e0833faec25c6aad530e4d1841df 100644 (file)
--- a/selfforum-cgi/user/fo_view.pl
+++ b/selfforum-cgi/user/fo_view.pl
@@ -19,17 +19,17 @@ use vars qw(
 );
 
 BEGIN {
-#  my $null = $0; $null =~ s/\\/\//g; # for win :-(
-#  $Bin     = ($null =~ /^(.*)\/.*$/)? $1 : '.';
-#  $Shared  = "$Bin/../shared";
-#  $Config  = "$Bin/config";
-#  $Script  = ($null =~ /^.*\/(.*)$/)? $1 : $null;
-
-  my $null = $0; #$null =~ s/\\/\//g; # for win :-(
+  my $null = $0; $null =~ s/\\/\//g; # for win :-(
   $Bin     = ($null =~ /^(.*)\/.*$/)? $1 : '.';
-  $Config  = "$Bin/../../../cgi-config/devforum";
-  $Shared  = "$Bin/../../../cgi-shared";
+  $Shared  = "$Bin/../shared";
+  $Config  = "$Bin/config";
   $Script  = ($null =~ /^.*\/(.*)$/)? $1 : $null;
+
+#  my $null = $0; #$null =~ s/\\/\//g; # for win :-(
+#  $Bin     = ($null =~ /^(.*)\/.*$/)? $1 : '.';
+#  $Config  = "$Bin/../../../cgi-config/devforum";
+#  $Shared  = "$Bin/../../../cgi-shared";
+#  $Script  = ($null =~ /^.*\/(.*)$/)? $1 : $null;
 }
 
 use lib "$Shared";

diff --git a/selfforum-cgi/user/fo_voting.pl b/selfforum-cgi/user/fo_voting.pl
index 284857e4938a9922111a237bc4e32c8f7e0ab765..7dddc53b2451a545640e944ce1b0072b3b2fe896 100644 (file)
--- a/selfforum-cgi/user/fo_voting.pl
+++ b/selfforum-cgi/user/fo_voting.pl
@@ -19,17 +19,17 @@ use vars qw(
 );
 
 BEGIN {
-#  my $null = $0; $null =~ s/\\/\//g; # for win :-(
-#  $Bin     = ($null =~ /^(.*)\/.*$/)? $1 : '.';
-#  $Shared  = "$Bin/../shared";
-#  $Config  = "$Bin/config";
-#  $Script  = ($null =~ /^.*\/(.*)$/)? $1 : $null;
-
-  my $null = $0; #$null =~ s/\\/\//g; # for win :-(
+  my $null = $0; $null =~ s/\\/\//g; # for win :-(
   $Bin     = ($null =~ /^(.*)\/.*$/)? $1 : '.';
-  $Config  = "$Bin/../../../cgi-config/devforum";
-  $Shared  = "$Bin/../../../cgi-shared";
+  $Shared  = "$Bin/../shared";
+  $Config  = "$Bin/config";
   $Script  = ($null =~ /^.*\/(.*)$/)? $1 : $null;
+
+#  my $null = $0; #$null =~ s/\\/\//g; # for win :-(
+#  $Bin     = ($null =~ /^(.*)\/.*$/)? $1 : '.';
+#  $Config  = "$Bin/../../../cgi-config/devforum";
+#  $Shared  = "$Bin/../../../cgi-shared";
+#  $Script  = ($null =~ /^.*\/(.*)$/)? $1 : $null;
 }
 
 use lib $Shared;