From 9b9648223ab2db3960298d04b83ecdd147ec21e9 Mon Sep 17 00:00:00 2001
From: ndparker <>
Date: Thu, 3 May 2001 09:56:32 +0000
Subject: [PATCH] CheckRFC: https-links now will be matched Id: added 'may_id'
 function fo_posting.pl: added type check on 'unique id' fo_posting.xml: added
 type 'unique-id' (for unid form field)

---
 selfforum-cgi/shared/CheckRFC.pm         |   4 +-
 selfforum-cgi/shared/Id.pm               | 105 ++++++++++++-----------
 selfforum-cgi/user/config/fo_posting.xml |   5 +-
 selfforum-cgi/user/fo_posting.pl         |  12 ++-
 4 files changed, 72 insertions(+), 54 deletions(-)

diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm
index cb9a616..639f77f 100644
--- a/selfforum-cgi/shared/CheckRFC.pm
+++ b/selfforum-cgi/shared/CheckRFC.pm
@@ -228,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*)";
diff --git a/selfforum-cgi/shared/Id.pm b/selfforum-cgi/shared/Id.pm
index fb51d48..480a57e 100644
--- a/selfforum-cgi/shared/Id.pm
+++ b/selfforum-cgi/shared/Id.pm
@@ -1,62 +1,61 @@
-# Id.pm
+package Id;
 
-##############################################
-#                                            #
-# Autor: n.d.p. / nd@o3media.de              #
-#                                            #
-# Letze Aenderung: n.d.p. / 2001-01-28       #
-#                                            #
-# ========================================== #
-#                                            #
-# Funktion:                                  #
-#                                            #
-# Bereitsstellen einer einmaligen ID         #
-#                                            #
-##############################################
+################################################################################
+#                                                                              #
+# File:        shared/Id.pm                                                    #
+#                                                                              #
+# Authors:     André Malo <nd@o3media.de>, 2001-05-03                          #
+#                                                                              #
+# Description: compose an unique ID (in CGI context)                           #
+#                                                                              #
+################################################################################
 
 use strict;
+use vars qw(
+  @table
+  @EXPORT
+);
 
-package Id;
-
-#####################
-# Funktionsexport
-#####################
-
+################################################################################
+#
+# Export
+#
 use base qw(Exporter);
-@Id::EXPORT = qw(unique_id);
-
-use vars qw(@table);
-
-##########################################
-# EXPORT                                 #
-#                                        #
-# sub &unique_id                         #
-#                                        #
-# Funktion:                              #
-#      Rueckgabe der ID                  #
-##########################################
+@EXPORT = qw(
+  unique_id
+  may_id
+);
 
-# sub unique_id ################################################
+### sub unique_id () ###########################################################
 #
-# composing of an unique ID...
+# compose an unique ID
+#
+# Params: ~none~
+#
+# Return: Scalar: unique ID
 #
 sub unique_id () {
   my $id;
 
-  my $ip=$ENV{'REMOTE_ADDR'};
-  my $time=time();
-  my $port=$ENV{'REMOTE_PORT'};
-  my $rand=int(rand(time()));
-  $ip =  hex(join ('',map {sprintf ('%02X',$_)} split (/\./,$ip)));
+  my $ip=$ENV{REMOTE_ADDR};
+  my $time=time;
+  my $port=$ENV{REMOTE_PORT};
+  my $rand=int(rand(time));
 
-  join '',map {to_base64 ($_)} ($time, $port, $ip, $rand, $$);
+  # works only with IPv4! (will be changed later...)
+  #
+  $ip = hex(join ('',map {sprintf ('%02X',$_)} split (/\./,$ip)));
+
+  join '' => map {to_base64 ($_)} ($time, $port, $ip, $rand, $$);
 }
 
-# sub to_base64 ################################################
+### sub to_base64 ($) ##########################################################
+#
+# only converts (max.) 32-bit numbers into a system with base 64
 #
-# only converts (max.) 32-bit numbers into a
-# system with base 64
-# its not the RFC base64 format!
+# Params: $x - number to convert
+#
+# Return: converted number ;-)
 #
 sub to_base64 ($) {
   my $x = shift;
@@ -68,13 +67,21 @@ sub to_base64 ($) {
 }
 
 BEGIN {
-  srand(time()^$$);
+  # 64 'digits' (for our base 64 system)
+  #
   @table = ('a'..'z','-','0'..'9','A'..'Z','_');
+
+  # define sub may_id
+  #
+  *may_id = eval join quotemeta join ('' => @table) => (
+    q[sub {local $_=shift; defined and length and not y/],
+    q[//cd;}]
+  );
 }
 
-# making 'require' happy
+# keep require happy
 1;
 
-#####################
-# end of Id
-#####################
\ No newline at end of file
+#
+#
+### end of Id ##################################################################
\ No newline at end of file
diff --git a/selfforum-cgi/user/config/fo_posting.xml b/selfforum-cgi/user/config/fo_posting.xml
index 5dcf516..8529509 100644
--- a/selfforum-cgi/user/config/fo_posting.xml
+++ b/selfforum-cgi/user/config/fo_posting.xml
@@ -112,12 +112,13 @@
               <Variable name="name">_FORM_UNID_NAME</Variable>
               <Variable name="value">_FORM_UNID_VALUE</Variable>
               <Variable name="too_long">_MANIPULATED</Variable>
+              <Variable name="wrong_unique_id">_MANIPULATED</Variable>
             </Property>
 
             <Variable name="name">unid</Variable>
-            <Variable name="maxlength">40</Variable>
+            <Variable name="maxlength">25</Variable>
             <Variable name="errorType">fatal</Variable>
-            <Variable name="type">internal</Variable>
+            <Variable name="type">unique-id</Variable>
           </Property>
 
           <Property name="quoteChar">
diff --git a/selfforum-cgi/user/fo_posting.pl b/selfforum-cgi/user/fo_posting.pl
index f4c6da0..1fe42a9 100644
--- a/selfforum-cgi/user/fo_posting.pl
+++ b/selfforum-cgi/user/fo_posting.pl
@@ -783,7 +783,7 @@ sub check_cgi {
     #
     my ($ftid, $fmid) = split /;/ => $q -> param ($formdata -> {followUp} -> {name}) => 2;
 
-    unless ($ftid =~ /\d+/ and $fmid =~ /\d+/) {
+    unless ($ftid =~ /^\d+$/ and $fmid =~ /^\d+$/) {
       $self -> {error} = {
         spec => 'unknown_followup',
         type => 'fatal'
@@ -880,6 +880,16 @@ sub check_cgi {
         };
         $self -> kill_param or return;
       }
+
+      elsif ($formdata -> {$name {$_}} -> {type} eq 'unique-id' and not may_id $val) {
+        $self -> {error} = {
+          spec => 'wrong_unique_id',
+          desc => $name{$_},
+          type => $formdata -> {$name {$_}} -> {errorType}
+        };
+          print STDERR "Manipuliert!";
+        $self -> kill_param or return;
+      }
     }
 
     if (exists ($formdata -> {$name {$_}} -> {values})
-- 
2.34.1