#!/usr/local/bin/perl5.00502 # Copyright (c) 1998, 1999 The RIPE NCC # # All Rights Reserved # # Permission to use, copy, modify, and distribute this software and its # documentation for any purpose and without fee is hereby granted, # provided that the above copyright notice appear in all copies and that # both that copyright notice and this permission notice appear in # supporting documentation, and that the name of the author not be # used in advertising or publicity pertaining to distribution of the # software without specific, written prior permission. # # THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING # ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL # AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY # DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN # AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. #------------------------------------------------------------------------------ # Filename : web141.pl.cgi # Version : 1.0.1 # Purpose : Allow user to generate a plain text RIPE 141 address # request form, and have it syntax checked # Author : Maldwyn GT Morris # Date : 19990210 # Description : Takes input from web form. One button will put this data # into a plain text RIPE 141 form, ready for email to RIPE NCC. Another # button will syntax check this data using the RIPE NCC syntax checker, # autohm. # Language Version : Tested with Perl 5.00502 # OSs Tested : BSDI BSD/OS 3.1 - No knownOS dependencies. # Command Line : None # Input Files : CGI, # cats standard header file: header.html # points to form explanations in: explanations.html # points to ripe 142 doc at: ripe-142.html # Output Files : stdout, temp file for autohm to read, error file for # autohm output # External Programs : whois, autohm # Problems : can't come back to same place on form when press # add or delete line buttons # To Do : # Comments : Simple but long-winded # : Disclaimer: http://winn.com/bs/disclaimer.html #------------------------------------------------------------------------------ #------------------------------------------------------------------------------ # Module Change History # Author : MGTM # Date : 19990223 # Changes : # Make spaces in template headers consistent, inserted missing text # ( 'TEMPLATE' ! ) and other minor syntax errors # Made Notify, MntBy, Changed fields allow wider input # Tidied handling of Request Overview multi-line fields # Comments : #------------------------------------------------------------------------------ # tested with perl 5.00502 # syntax checked with perl 5.00307 require 5; # unbuffer stdout $| = 1; $ENV{'PATH'} = "/bin:/usr/bin:/usr/ucb"; # always ! use strict; # for the form use CGI; # resists DOS by large posts $CGI::POST_MAX=1024 * 1000; # max 1000K posts $CGI::DISABLE_UPLOADS = 1; # no file uploads #------------------------------------------------------------------------------ # globals my $debug; # global flag # $debug=1; # DEBUG my $query = new CGI; # global object my $myself; # global pointer to this form my $goto; # used to set # part of url to jump back to the # section where we added or deleted a line my $errors; # global error messages my ( $MAXLINES ) = 5; # max amount lines my ( $title ) = 'European IP Address Space Request Syntax Checker'; if ( $debug ) { $title .= ' - TEST'; } # array of filled-in usages my ( @usages ); # constants # !! CHANGE THESE TO MATCH YOUR SITE !! # RIPE NCC standard HTML header - has a and a
in it my $STANDARDHEADERPATH = '/.../standard.html'; my $RIPE141URL = 'http://.../ripe-141.html'; my $RIPE142URL = 'http://.../ripe-142.html'; my $TEMPDIR = '/.../tmp'; my $AUTOHMPATH = '/.../auto-hmweb.pl'; my $WHOISPATH = '/.../whois'; my $WHOIS_NOTFOUND_REG = 'No\s+entries\s+found'; # INSENSITIVE my $FATAL_ERROR_EXIT_TXT = '-=- EXITED WITH FATAL ERROR -=-'; # autohm error #------------------------------------------------------------------------------ # List of routines # # Major ones : # # main : look at query url and decide what to do based on params set: # - reload a filled in form # - add a line to one of the multi-line entries # - delete a line from one of the multi-line entries # - convert request to plain text # - run syntax checks on request # else just show the form # # displayPage : form and show the HTML of the page # doCall : send plain text of page to autohm and show results # showPlainText : show form data as plain text RIPE 141 form # # Minor Ones : # # header, footer : print the top and bottom of the form # showFormControls : print the submit and reset buttons # getparam : get value of a query param or return '' - not undef # moveField : move a multi-line entry field # dprint : show debug message if debugging # error : show error message in HTML # #------------------------------------------------------------------------------ # Main routine # Purpose : shows web form or acts on it # Side Effects : none # Comments : too long { # get url called with my ( $my_url ) = $query->url(-path_info=>1,-query=>1); # if any params, handle form if ( $query->param ) # handle form { my ( $reload ) = $query->param( -name=>'reload' ); my ( $convert ) = $query->param( -name=>'Convert' ); my ( $addUsage ) = $query->param( -name=>'AddUsageLine' ); my ( $deleteUsage ) = $query->param( -name=>'DeleteUsageLine' ); my ( $addRequest ) = $query->param( -name=>'AddRequestLine' ); my ( $deleteRequest ) = $query->param( -name=>'DeleteRequestLine' ); my ( $addPerson ) = $query->param( -name=>'AddPersonLine' ); my ( $deletePerson ) = $query->param( -name=>'DeletePersonLine' ); my ( $addNetwork ) = $query->param( -name=>'AddNetworkLine' ); my ( $deleteNetwork ) = $query->param( -name=>'DeleteNetworkLine' ); # what are we doing here ? if ( defined $reload ) # reload is set when we want to go back to *filled in* form { # debug - show url called with my $extra; if ( $debug ) { $extra = "$my_url
\n"; } &header( $extra); displayPage( $query, '' ); &footer(); } elsif ( defined $addUsage ) # add usage line { # debug - show url called with my $extra; if ( $debug ) { $extra = "Add $my_url
\nAdding usage line.
\n"; } &header( $extra); my $addUsageLine; if ( $addUsage =~ /^Add\sUsage\sLine\s(\d+)$/ ) { $addUsageLine = $1; } else { error( "addUsage = $addUsage ? so don\'t understand self URL $my_url" ); return; } # new number of lines $query->param( "UsageCount", $addUsageLine ); dprint( "
addUsage = $addUsage, addLine = UsageCount = $addUsageLine
\n" ); # show it displayPage( $query, '' ); &footer(); } elsif ( defined $deleteUsage ) # delete usage line { # debug - show url called with my $extra; if ( $debug ) { $extra = "$my_url
\n"; } &header( $extra); my $deleteUsageLine; if ( $deleteUsage =~ /^Delete\sUsage\sLine\s(\d+)$/ ) { $deleteUsageLine = $1; } else { error( "deleteUsage = $deleteUsage ? so don\'t understand self URL $my_url" ); return; } # how many lines now ? my $lastLine = $query->param( "UsageCount" ); dprint( "
deleteUsage = $deleteUsageLine lastLine = $lastLine
\n" ); # remove line by moving next ones down over it my $line; for ( $line = $deleteUsageLine; $line<$lastLine; $line++ ) { # move the fields down by one line moveField( ( "Prefix" . ($line + 1) ), ( "Prefix" . ($line) ) ); moveField( ( "Mask" . ($line + 1) ), ( "Mask" . ($line) ) ); moveField( ( "Size" . ($line + 1) ), ( "Size" . ($line) ) ); moveField( ( "Current" . ($line + 1) ), ( "Current" . ($line) ) ); moveField( ( "OneYear" . ($line + 1) ), ( "OneYear" . ($line) ) ); moveField( ( "TwoYear" . ($line + 1) ), ( "TwoYear" . ($line) ) ); moveField( ( "Description" . ($line + 1) ), ( "Description" . ($line) ) ); } # now set last line one less $query->param( "UsageCount", $lastLine-1 ); # show it displayPage( $query, '' ); &footer(); } elsif ( defined $addRequest ) # add request line { &header(); my $addRequestLine; if ( $addRequest =~ /^Add\sRequest\sLine\s(\d+)$/ ) { $addRequestLine = $1; } else { error( "addRequest = $addRequest ? so don\'t understand self URL $my_url" ); return; } # new number of lines $query->param( "RequestCount", $addRequestLine ); dprint( "
addRequest = $addRequest, addLine = RequestCount = $addRequestLine
\n" ); # show it displayPage( $query, '' ); &footer(); } elsif ( defined $deleteRequest ) # delete request line { &header(); my $deleteRequestLine; if ( $deleteRequest =~ /^Delete\sRequest\sLine\s(\d+)$/ ) { $deleteRequestLine = $1; } else { error( "deleteRequest = $deleteRequest ? so don\'t understand self URL $my_url" ); return; } # how many lines now ? my $lastLine = $query->param( "RequestCount" ); dprint( "
deleteRequest = $deleteRequestLine lastLine = $lastLine
\n" ); # remove line by moving next ones down over it my $line; for ( $line = $deleteRequestLine; $line<$lastLine; $line++ ) { # move the fields down by one line moveField( ( "RequestPrefix" . ($line + 1) ), ( "RequestPrefix" . ($line) ) ); moveField( ( "RequestMask" . ($line + 1) ), ( "RequestMask" . ($line) ) ); moveField( ( "RequestSize" . ($line + 1) ), ( "RequestSize" . ($line) ) ); moveField( ( "RequestImmediate" . ($line + 1) ), ( "RequestImmediate" . ($line) ) ); moveField( ( "RequestOneYear" . ($line + 1) ), ( "RequestOneYear" . ($line) ) ); moveField( ( "RequestTwoYear" . ($line + 1) ), ( "RequestTwoYear" . ($line) ) ); moveField( ( "RequestDescription" . ($line + 1) ), ( "RequestDescription" . ($line) ) ); } # now set last line one less $query->param( "RequestCount", $lastLine-1 ); # show it displayPage( $query, '' ); &footer(); } elsif ( defined $addPerson ) # add person line { # debug - show url called with my $extra; if ( $debug ) { $extra = "AddP $my_url
\nAdding person line.
\n"; } &header( $extra); my $addPersonLine; if ( $addPerson =~ /^Add\sPerson\sLine\s(\d+)$/ ) { $addPersonLine = $1; } else { error( "addPerson = $addPerson ? so don\'t understand self URL $my_url" ); return; } # new number of lines $query->param( "PersonCount", $addPersonLine ); dprint( "
addPerson = $addPerson, addLine = PersonCount = $addPersonLine
\n" ); # show it displayPage( $query, '' ); &footer(); } elsif ( defined $deletePerson ) # delete usage line { # debug - show url called with my $extra; if ( $debug ) { $extra = "DeleteP $my_url
\n"; } &header( $extra); my $deletePersonLine; if ( $deletePerson =~ /^Delete\sPerson\sLine\s(\d+)$/ ) { $deletePersonLine = $1; } else { error( "deletePerson = $deletePerson ? so don\'t understand self URL $my_url" ); return; } # how many lines now ? my $lastLine = $query->param( "PersonCount" ); dprint( "
deletePerson = $deletePersonLine lastLine = $lastLine
\n" ); # remove line by moving next ones down over it my $line; for ( $line = $deletePersonLine; $line<$lastLine; $line++ ) { # move fields down by one line moveField( ( "PersonName" . ($line + 1) ), ( "PersonName" . ($line) ) ); moveField( ( "PersonAddress" . ($line + 1) ), ( "PersonAddress" . ($line) ) ); moveField( ( "PersonEmail" . ($line + 1) ), ( "PersonEmail" . ($line) ) ); moveField( ( "PersonPhone" . ($line + 1) ), ( "PersonPhone" . ($line) ) ); moveField( ( "PersonFax" . ($line + 1) ), ( "PersonFax" . ($line) ) ); moveField( ( "PersonNicHdl" . ($line + 1) ), ( "PersonNicHdl" . ($line) ) ); moveField( ( "PersonNotify" . ($line + 1) ), ( "PersonNotify" . ($line) ) ); moveField( ( "PersonMntBy" . ($line + 1) ), ( "PersonMntBy" . ($line) ) ); moveField( ( "PersonChanged" . ($line + 1) ), ( "PersonChanged" . ($line) ) ); } # now set last line one less $query->param( "PersonCount", $lastLine-1 ); # show it displayPage( $query, '' ); &footer(); } elsif ( defined $addNetwork ) # add person line { # debug - show url called with my $extra; if ( $debug ) { $extra = "AddN $my_url
\nAdding person line.
\n"; } &header( $extra); my $addNetworkLine; if ( $addNetwork =~ /^Add\sNetwork\sLine\s(\d+)$/ ) { $addNetworkLine = $1; } else { error( "addNetwork = $addNetwork ? so don\'t understand self URL $my_url" ); return; } # new number of lines $query->param( "NetworkCount", $addNetworkLine ); dprint( "
addNetwork = $addNetwork, addLine = NetworkCount = $addNetworkLine
\n" ); # show it displayPage( $query, '' ); &footer(); } elsif ( defined $deleteNetwork ) # delete usage line { # debug - show url called with my $extra; if ( $debug ) { $extra = "DeleteN $my_url
\n"; } &header( $extra); my $deleteNetworkLine; if ( $deleteNetwork =~ /^Delete\sNetwork\sLine\s(\d+)$/ ) { $deleteNetworkLine = $1; } else { error( "deleteNetwork = $deleteNetwork ? so don\'t understand self URL $my_url" ); return; } # how many lines now ? my $lastLine = $query->param( "NetworkCount" ); dprint( "
deleteNetwork = $deleteNetworkLine lastLine = $lastLine
\n" ); # remove line by moving next ones down over it my $line; for ( $line = $deleteNetworkLine; $line<$lastLine; $line++ ) { moveField( ( "NetName" . ($line + 1) ), ( "NetName" . ($line) ) ); moveField( ( "NetDescription" . ($line + 1) ), ( "NetDescription" . ($line) ) ); moveField( ( "NetCountry" . ($line + 1) ), ( "NetCountry" . ($line) ) ); moveField( ( "NetAdminC" . ($line + 1) ), ( "NetAdminC" . ($line) ) ); moveField( ( "NetTechC" . ($line + 1) ), ( "NetTechC" . ($line) ) ); moveField( ( "NetNotify" . ($line + 1) ), ( "NetNotify" . ($line) ) ); moveField( ( "NetMntBy" . ($line + 1) ), ( "NetMntBy" . ($line) ) ); #moveField( ( "NetChanged" . ($line + 1) ), ( "NetChanged" . ($line) ) ); } # now set last line one less $query->param( "NetworkCount", $lastLine-1 ); # show it displayPage( $query, '' ); &footer(); } elsif ( defined $convert ) # convert to plain text { # syntax checks not done my $fh = \*STDOUT; showPlainText( $fh, $query, 0 ); } else # submit # form was submitted - want to handle form { $query->param( 'reload', '1' ); $myself = $query->self_url; # debug - show url called with my $extra; if ( $debug ) { $extra = "$my_url
\n"; } &header( $extra); # handle form input &doCall( $query ); &footer(); } } else # no params, show form { # debug - show url called with my $extra; if ( $debug ) { $extra = "$my_url
\n"; } &header( $extra ); displayPage( $query, '' ); &footer(); } # done exit( 0 ); } #------------------------------------------------------------------------------ # page header sub header { my ( $extraText ) = @_; # ARGS: extra stuff to show or empty print $query->header; # print $query->start_html( # -title => $title, # -dtd => '-//W3C//DTD HTML 4.0 Transitional//EN' # ); # do it ourselves as CGI.pm inserts as does RIPE header print ' '; print "\n $title \n\n"; # RIPE standard header open ( STDHDR, "<$STANDARDHEADERPATH" ) or error( "could not open standard header file $STANDARDHEADERPATH." ); my @standardHeader = ; close STDHDR; print "@standardHeader\n"; print "$extraText\n"; return; } #------------------------------------------------------------------------------ # page footer sub footer { # RIPE standard header has
, so print "
\n"; print $query->end_html; return; } #------------------------------------------------------------------------------ sub showFormControls { print "
"; print $query->submit( -name=>'Check', -value=>'Syntax Check this Request' ); print $query->submit( -name=>'Convert', -value=>'Convert this Request to plain text' ); print $query->reset( -value=>'Reset all the fields' ); print "
"; return; } #------------------------------------------------------------------------------ # Purpose : generates web form HTML # Side Effects : none # Comments : too long sub displayPage { my ( $query, $add, %errors ) = @_; print "

$title

\n\n"; print "

\n"; my $oururl = $query->url; my ( $addUsage ) = $query->param( -name=>'AddUsageLine' ); my ( $deleteUsage ) = $query->param( -name=>'DeleteUsageLine' ); my ( $addRequest ) = $query->param( -name=>'AddRequestLine' ); my ( $deleteRequest ) = $query->param( -name=>'DeleteRequestLine' ); my ( $addPerson ) = $query->param( -name=>'AddPersonLine' ); my ( $deletePerson ) = $query->param( -name=>'DeletePersonLine' ); my ( $addNetwork ) = $query->param( -name=>'AddNetworkLine' ); my ( $deleteNetwork ) = $query->param( -name=>'DeleteNetworkLine' ); if ( $addUsage || $deleteUsage ) { $goto = '#USAGE'; } elsif ( $addRequest || $deleteRequest ) { $goto = '#REQUEST'; } print $query->start_form( -method=>'POST', -action=>"$oururl$goto" ); #---- if ( defined %errors ) { print "

Errors were found in your request

"; print "Please correct them and re-submit the form \n"; } #---- print < RIPE 141 format or to convert it to formatted plain text with no checking.

The RIPE 141 format is explained in RIPE 142

Note that only syntax checks will be performed and nothing will be done with your request. To actually be given addresses, you must send the plain text version of your request by email to hostmaster\@ripe.net and you must be registered with RIPE NCC . Further automatic and human checks must also be passed.

EOINTROTEXT ; showFormControls(); #---- print "

I. General Information

"; print "
"; print "

#[ OVERVIEW OF ORGANISATION TEMPLATE ]#

"; print "Please fill in a description of your company and what the addresses will be used for.
\n"; print " Help with this section
\n"; print $query->textarea( -name=>'OrganisationDescription', -cols=>80, -rows=>3, -value=>getparam( 'OrganisationDescription' ) ); if ( $errors{ 'OrganisationDescription' } ) { print "$errors{ 'OrganisationDescription' } "; } print "
\n"; #---- print "

#[ REQUESTER TEMPLATE ]#

"; print "Help with this section
\n"; print ""; print ""; print ""; print ""; if ( $errors{ 'RequesterName' } ) { print ""; } print ""; print ""; print ""; print ""; if ( $errors{ 'RequesterOrganisation' } ) { print $errors{ 'RequesterOrganisation' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'RequesterCountry' } ) { print $errors{ 'Country' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'RequesterPhone' } ) { print $errors{ 'RequesterPhone' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'RequesterFax' } ) { print $errors{ 'RequesterFax' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'RequesterEmail' } ) { print $errors{ 'RequesterEmail' }; } print ""; print "
Requester Name"; print $query->textfield( -name=>"RequesterName", -size=>64, -maxlength=>256, -value=>getparam( 'RequesterName' ), ); print "$errors{ 'RequesterName' }
RequesterOrganisation"; print $query->textfield( -name=>"RequesterOrganisation", -size=>64, -maxlength=>256, -value=>getparam( "RequesterOrganisation" ), ); print "
RequesterCountry"; print $query->textfield( -name=>"RequesterCountry", -size=>2, -maxlength=>2, -value=>getparam( "RequesterCountry" ), ); print "
Requester Telephone Number"; print $query->textfield( -name=>"RequesterPhone", -size=>17, -maxlength=>256, -value=>getparam( "RequesterPhone" ), ); print "
Fax Number"; print $query->textfield( -name=>"RequesterFax", -size=>17, -maxlength=>256, -value=>( getparam( "RequesterFax" ) ), ); print "
Email Address"; print $query->textfield( -name=>"RequesterEmail", -size=>32, -maxlength=>256, -value=>( getparam( "RequesterEmail" ) ), ); print "
"; #---- print "

#[ USER TEMPLATE ]#

"; print "Please fill in contact information about your organisation.
\n"; print "Help with this section
\n"; print ""; # something to jump to print "\n"; print ""; print ""; print ""; if ( $errors{ 'UserName' } ) { print ""; } print ""; print ""; print ""; print ""; if ( $errors{ 'UserOrganisation' } ) { print $errors{ 'UserOrganisation' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'UserCountry' } ) { print $errors{ 'Country' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'UserPhone' } ) { print $errors{ 'UserPhone' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'UserFax' } ) { print $errors{ 'UserFax' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'UserEmail' } ) { print $errors{ 'UserEmail' }; } print ""; print "
Contact Name"; print $query->textfield( -name=>"UserName", -size=>64, -maxlength=>256, -value=>getparam( 'UserName' ), ); print "$errors{ 'UserName' }
UserOrganisation"; print $query->textfield( -name=>"UserOrganisation", -size=>64, -maxlength=>256, -value=>getparam( "UserOrganisation" ), ); print "
UserCountry"; print $query->textfield( -name=>"UserCountry", -size=>2, -maxlength=>2, -value=>getparam( "UserCountry" ), ); print "
User Telephone Number"; print $query->textfield( -name=>"UserPhone", -size=>64, -maxlength=>256, -value=>getparam( "UserPhone" ), ); print "
Fax Number"; print $query->textfield( -name=>"UserFax", -size=>64, -maxlength=>256, -value=>( getparam( "UserFax" ) ), ); print "
Email Address"; print $query->textfield( -name=>"UserEmail", -size=>32, -maxlength=>256, -value=>( getparam( "UserEmail" ) ), ); print "
"; #---- print "
\n"; print "

#[ CURRENT ADDRESS SPACE USAGE TEMPLATE ]#

"; # something to jump to print "\n"; print " Help with this section
\n"; # hidden field to store number of current usage lines my $usageCount; print $query->hidden( 'UsageCount', getparam( "UsageCount" ) ); $usageCount = getparam( "UsageCount" ) ; if ( $usageCount eq '' ) { $usageCount = 0; } # make numeric dprint( "
count:$usageCount
\n" ); my $nextFree = $usageCount + 1; print ""; # header1 print ""; print ""; print ""; print ""; print ""; print ""; print ""; # header2 print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; # data # show up to and including last line my $line; for ( $line=0; $line <= $usageCount; $line++ ) { print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; } print ""; print ""; print ""; print ""; print ""; print ""; print ""; print "
Addresses Used
"; print $query->submit( -name=>'AddUsageLine', -value=>"Add Usage Line $nextFree", ); print "PrefixSubnet MaskSizeCurrentOne YearTwo YearDescription
"; print $query->submit( -name=>"DeleteUsageLine", -value=>"Delete Usage Line $line", ); print ""; print $query->textfield( -name=>"Prefix$line", -size=>15, -maxlength=>15, -value=>(getparam( "Prefix$line" )), ); print ""; print $query->textfield( -name=>"Mask$line", -size=>15, -maxlength=>15, -value=>(getparam( "Mask$line" )), ); print ""; print $query->textfield( -name=>"Size$line", -size=>4, -maxlength=>8, -value=>(getparam( "Size$line" )), ); print ""; print $query->textfield( -name=>"Current$line", -size=>4, -maxlength=>8, -value=>(getparam( "Current$line" )), ); print ""; print $query->textfield( -name=>"OneYear$line", -size=>4, -maxlength=>8, -value=>(getparam( "OneYear$line" )), ); print ""; print $query->textfield( -name=>"TwoYear$line", -size=>4, -maxlength=>8, -value=>(getparam( "TwoYear$line" )), ); print ""; print $query->textfield( -name=>"Description$line", -size=>40, -maxlength=>256, -value=>(getparam( "Description$line" )), ); print "
"; print "Please use this section if you find it easier to just paste in your current usage. It will also be put in the 141 form and syntax checked."; print "
"; print ""; print $query->textarea( -name=>'FreeFormUsage', -cols=>80, -rows=>3, -value=>getparam( 'FreeFormUsage' ) ); print "
"; print "
"; #----------------------------------------- print "
\n"; print"

II. The Request


\n"; print "
"; print "

#[ REQUEST OVERVIEW TEMPLATE ]#

"; print "

"; print "Please answer the following questions about your request.
\n"; print " Help with this section
\n"; print "

"; print ""; #----- print ""; print ""; print ""; if ( $errors{ 'WhenConnect' } ) { print $errors{ 'WhenConnect' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'WhichCountry' } ) { print $errors{ 'WhichCountry' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'PrivateAddresses' } ) { print $errors{ 'PrivateAddresses' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'Refused' } ) { print $errors{ 'Refused' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'WhyRefused' } ) { print $errors{ 'WhyRefused' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'PI' } ) { print $errors{ 'PI' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'Returning' } ) { print $errors{ 'Returning' }; } print ""; print ""; print ""; print ""; if ( $errors{ 'WhatReturn' } ) { print $errors{ 'WhatReturn' }; } print ""; print "
When will you connect to the Internet and to whom ? "; print $query->textfield( -name=>'WhenConnect', -size=>48, -maxlength=>256, -value=>(getparam( 'WhenConnect' )), ); print "
What country is the headquarters located ? "; print $query->textfield( -name=>'WhichCountry', -size=>2, -maxlength=>2, -value=>(getparam( 'WhichCountry' )), ); print "
Have you considered using private addresses ? "; print $query->radio_group( -name=>'PrivateAddresses', -'values'=>['Yes','No'], #-value=>getparam( 'PrivateAddresses' ) -default=>'No', ); print "
Has the request been refused in the past ? "; print $query->radio_group( -name=>'Refused', -'values'=>['Yes','No'], #-value=>getparam( 'Refused' ) -default=>'No', ); print "
If yes, why, and how has the situation changed ? "; print $query->textarea( -name=>'WhyRefused', -cols=>80, -rows=>3, -value=>getparam( 'WhyRefused' ) ); print "
Are you requesting Provider Independent addresses ? "; print $query->radio_group( -name=>'PI', -'values'=>['Yes','No'], #-value=>getparam( 'PI' ) -default=>'No', ); print "
Are you returning addresses ? "; print $query->radio_group( -name=>'Returning', -'values'=>['Yes','No'], #-value=>getparam( 'Returning' ), -default=>'No', ); print "
If yes, please fill in what range will be returned on what dates to what provider ? "; print $query->textarea( -name=>'WhatReturn', -cols=>80, -rows=>3, -value=>getparam( 'WhatReturn' ) ); print "
"; print "


\n"; #---- print"

#[ ADDRESSING PLAN TEMPLATE ]#


\n"; print " Help with this section
\n"; print "\n"; # hidden field to store number of request lines my $requestCount; print $query->hidden( 'RequestCount', getparam( "RequestCount" ) ); $requestCount = getparam( "RequestCount" ) ; if ( $requestCount eq '' ) { $requestCount = 0; } # make numeric dprint( "
count:$requestCount
\n" ); my $nextRequestFree = $requestCount + 1; print ""; print ""; print ""; # back print ""; print ""; print ""; print ""; print ""; print ""; print ""; # show up to and including last line my $requestLine; dprint( "
count:$requestCount
\n" ); for ( $requestLine= 0; $requestLine <= $requestCount; $requestLine ++ ) { print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; } print ""; print ""; print ""; print ""; print ""; print ""; print ""; print "
"; print $query->submit( -name=>'AddRequestLine', -value=>"Add Request Line $nextRequestFree", ); print "Relative PrefixSubnet MaskSize Hosts ImmediateHosts Year OneHosts Year TwoDescription
"; print $query->submit( -name=>"DeleteRequestLine", -value=>"Delete Request Line $requestLine", ); print ""; if ( $requestLine == 0 ) { print "0.0.0.0"; } else { print $query->textfield( -name=>"RequestPrefix$requestLine", -size=>15, -maxlength=>15, -value=>(getparam( "RequestPrefix$requestLine" )), ); } print ""; print $query->textfield( -name=>"RequestMask$requestLine", -size=>15, -maxlength=>15, -value=>(getparam( "RequestMask$requestLine" )), ); print ""; print $query->textfield( -name=>"RequestSize$requestLine", -size=>4, -maxlength=>8, -value=>(getparam( "RequestSize$requestLine" )), ); print ""; print $query->textfield( -name=>"RequestImmediate$requestLine", -size=>4, -maxlength=>8, -value=>(getparam( "RequestImmedaite$requestLine" )), ); print ""; print $query->textfield( -name=>"RequestOneYear$requestLine", -size=>4, -maxlength=>8, -value=>(getparam( "RequestOneyear$requestLine" )), ); print ""; print $query->textfield( -name=>"RequestTwoYear$requestLine", -size=>4, -maxlength=>8, -value=>(getparam( "RequestTwoyear$requestLine" )), ); print ""; print $query->textfield( -name=>"RequestDescription$requestLine", -size=>40, -maxlength=>256, -value=>(getparam( "RequestDescription$requestLine" )), ); print "
"; print "Please use this section if you find it easier to just paste in your addressing plan. It will also be put in the 141 form and syntax checked."; print "
"; print ""; print $query->textarea( -name=>'FreeFormRequest', -cols=>80, -rows=>3, -value=>getparam( 'FreeFormRequest' ) ); print "
"; print "


\n"; print "

"; #---------------------------------- print "
\n"; print "

III. Database Information

"; print "
"; print "

#[ NETWORK TEMPLATE ]#

"; print " Help with this section
\n"; # hidden field to store number of network lines my $networkCount; print $query->hidden( 'NetworkCount', getparam( 'NetworkCount' ) ); $networkCount = getparam( "NetworkCount" ) ; if ( $networkCount eq '' ) { $networkCount = 0; } # make numeric my $nextFreeNetwork = $networkCount + 1; print ""; print ""; print ""; print ""; my $networkLine; for ( $networkLine= 0; $networkLine <= $networkCount; $networkLine++ ) { # delete button, name print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; # print ""; # print ""; # print ""; # print ""; } print "
"; print $query->submit( -name=>'AddNetworkLine', -value=>"Add Network Line $nextFreeNetwork", ); print "
"; print $query->submit( -name=>"DeleteNetworkLine", -value=>"Delete Network Line $networkLine", ); print "
Net Name"; print $query->textfield( -name=>"NetName$networkLine", -size=>32, -maxlength=>80, -value=>(getparam( "NetName$networkLine" )), ); print "
Description"; print $query->textarea( -name=>"NetDescription$networkLine", -cols=>80, -rows=>3, -value=>(getparam( "NetDescription$networkLine" )), ); print "
Country"; print $query->textfield( -name=>"NetCountry$networkLine", -size=>2, -maxlength=>2, -value=>(getparam( "NetCountry$networkLine" )), ); print "
Administrative Contact"; print $query->textfield( -name=>"NetAdminC$networkLine", -size=>15, -maxlength=>255, -value=>(getparam( "NetAdminC$networkLine" )), ); print "
Technical Contact"; print $query->textfield( -name=>"NetTechC$networkLine", -size=>15, -maxlength=>255, -value=>(getparam( "NetTechC" )), ); print "
Notify"; print $query->textfield( -name=>"NetNotify$networkLine", -size=>15, -maxlength=>64, -value=>(getparam( "NetNotify" )), ); print "
Mnt-By"; print $query->textfield( -name=>"NetMntBy$networkLine", -size=>15, -maxlength=>64, -value=>(getparam( "NetMntBy" )), ); print "
Changed"; # print $query->textfield( # -name=>"NetChanged$networkLine", # -size=>15, # -maxlength=>64, # -value=>(getparam( "NetChanged" )), # ); # print "
"; print "

"; #----- print "

#[ PERSON TEMPLATE ]#

"; print "Please fill in one template for each person that is not yet registered in the RIPE database and does not have a nic handle.
\n"; print " Help with this section
\n"; print "

"; # hidden field to store number of person lines my $personCount; print $query->hidden( 'PersonCount', getparam( 'PersonCount' ) ); $personCount = getparam( "PersonCount" ) ; if ( $personCount eq '' ) { $personCount = 0; } # make numeric my $nextFreePerson = $personCount + 1; # something to jump to print "\n"; print ""; print ""; print ""; print ""; my $personLine; for ( $personLine= 0; $personLine <= $personCount; $personLine++ ) { # delete button, name print ""; print ""; my $LOOKUPNICHDLMESSAGE; if ( ( -f $WHOISPATH ) && ( -x $WHOISPATH ) ) { $LOOKUPNICHDLMESSAGE = "If you fill in an existing Nic Handle here, the other person fields will be automatically filled in for you in the plain text form."; } else { $LOOKUPNICHDLMESSAGE = "Nic Handles will not be looked up"; } print ""; print ""; print ""; print ""; print ""; print ""; print ""; # address print ""; print ""; print ""; print ""; print ""; # email, phone, fax print ""; print ""; print ""; print ""; print ""; # nic-hdl, notify, mnt-by, changed print ""; print ""; print ""; print ""; print ""; print "\n"; } print "
"; print $query->submit( -name=>'AddPersonLine', -value=>"Add Person Line $nextFreePerson", ); print "
"; print $query->submit( -name=>"DeletePersonLine", -value=>"Delete Person Line $personLine", ); print " Nic-Hdl "; print ""; print ""; print ""; print ""; print ""; print "
"; print $query->textfield( -name=>"PersonNicHdl$personLine", -size=>15, -maxlength=>15, -value=>(getparam( "PersonNicHdl$personLine" )), ); print " $LOOKUPNICHDLMESSAGE
"; print "
Name"; print $query->textfield( -name=>"PersonName$personLine", -size=>32, -maxlength=>64, -value=>(getparam( "PersonName$personLine" )), ); print "
Address"; print $query->textarea( -name=>"PersonAddress$personLine", -cols=>80, -rows=>3, -value=>(getparam( "PersonAddress$personLine" )), ); print "
Email"; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print "
"; print $query->textfield( -name=>"PersonEmail$personLine", -size=>32, -maxlength=>64, -value=>(getparam( "PersonEmail$personLine" )), ); print "  Phone   "; print $query->textfield( -name=>"PersonPhone$personLine", -size=>15, -maxlength=>64, -value=>(getparam( "PersonPhone$personLine" )), ); print "  Fax   "; print $query->textfield( -name=>"PersonFax$personLine", -size=>15, -maxlength=>64, -value=>(getparam( "PersonFax$personLine" )), ); print "
"; print "
Notify"; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print "
"; print $query->textfield( -name=>"PersonNotify$personLine", -size=>15, -maxlength=>64, -value=>(getparam( "PersonNotify$personLine" )), ); print "  Mnt-by   "; print $query->textfield( -name=>"PersonMntBy$personLine", -size=>15, -maxlength=>64, -value=>(getparam( "PersonMntBy$personLine" )), ); print "  Changed   "; print $query->textfield( -name=>"PersonChanged$personLine", -size=>15, -maxlength=>64, -value=>(getparam( "PersonChanged$personLine" )), ); print "
"; print "
"; print "

"; #---------------------------------- print "
"; print "

IV. Optional Information

"; print "
"; print " Help with this section
\n"; print "Any additional information may be entered here. It will not be checked by the robot."; print $query->textarea( -name=>'Comments', -cols=>80, -rows=>3, -value=>getparam( 'Comments' ) ); if ( $errors{ 'Comments' } ) { print "$errors{ 'Comments' } "; } print "
\n"; print "
"; #---- print "
"; showFormControls(); #---- print $query->end_form, "\n"; print "

"; return; } #------------------------------------------------------------------------------ # Purpose : return param value or '' # main use is to prevent probs with undef # Side Effects : none # Comments : sub getparam { my ( $name ) = @_; # ARGS: param name my $val = $query->param( -name=> $name ); if ( defined $val ) { return $val; } else { return ''; } } #------------------------------------------------------------------------------ # Purpose : calls autohmweb.pl, echos response in html to stdout # Side Effects : none # Comments : HTML output sub doCall { my ( $query ) = @_; # put plain text in a file, call autohm-web.pl to check it, # and put the STDOUT from that on web page # cehck STDERR in err file for error message my ( $sec, $min, $hour, $day, $month, $year ) = localtime( time ); my $YYYYMMDDhhmmss = sprintf ( "%04d%02d%02d%02d%02d%02d", $year, $month, $day, $hour, $min, $sec ); my $errfile = "web141err.$YYYYMMDDhhmmss.$$"; my $errpath = "$TEMPDIR/$errfile"; my $tempfile = "$TEMPDIR/web141temp.$YYYYMMDDhhmmss.$$"; open ( ATEMP, "> $tempfile" ); showPlainText( \*ATEMP, $query, 0 ); close( ATEMP ); my $autohmwebOutput; my $autohmErr; if ( ! -f $tempfile ) { error( "error creating temp file" ); } else { if ( ! -x $AUTOHMPATH ) { error( "Cannot access syntax checking program $AUTOHMPATH" ); } else { open ( DOCHECK, "$AUTOHMPATH -web < $tempfile 2>$errpath |" ) or error( "Error running syntax checking program $AUTOHMPATH" ); # read stdout on pipe my $line; while ( defined ( $line = ) ) { $autohmwebOutput .= "$line
\n"; } $autohmErr = close ( DOCHECK ); } } # read stderr from file my $autohmwebErrors; if ( open ( ERRFILE, "$errpath" ) ) { my $errLine; while ( defined ( $errLine = ) ) { $autohmwebErrors .= $errLine; } close ERRFILE; } # show stuff my $autohmwebResult = 1; # 1 for pass, 0 for errors # in html format # errors ? if ( ( $autohmwebErrors =~ /FATAL_ERROR_EXIT_TXT/ ) || ( $autohmErr ne 1) ) # yes { print < Internal Error: Error $autohmErr from the syntax checking robot

Please contact the RIPE NCC , mentioning the URL of this page and file $errfile.

Your request in plain text suitable for mailing to hostmaster\@ripe.net follows, and should still be accurate, although it may fail syntax checks. EOERRORTXT ; print "

\n"; print "
";
                showPlainText( \*STDOUT, $query, $autohmwebResult );
                print "
"; # keep temp file # keep err file } else # no errors { print $autohmwebOutput; print "

"; print "

\n"; print "
";
		showPlainText( \*STDOUT, $query, $autohmwebResult );
		print "
"; # remove temp file if ( !$debug ) { unlink ( $tempfile ); } # remove err file unlink ( $errfile ); } # done return; } #------------------------------------------------------------------------------ # Purpose : print entered data in plain text form for cut and paste # into a mail to RIPE NCC # Side Effects : none # Comments : too long sub showPlainText { my ( $fh, $query, $autohmChecked ) = @_; # file handle, query # checkflag: 1 if checked & OK, # else 0 my ( $my_url ) = $query->self_url; my $checkedText; if ( $autohmChecked ) { $checkedText = 'Please note that this text has been checked only for syntax errors\nand may fail other checks of the RIPE NCC Address Checking Robot.'; } else { $checkedText = 'Please note that this text may fail the syntax or other checks of the RIPE NCC Address Checking Robot.'; } # split url into fields my %fields; my @fields = $query->param; my $field; foreach $field ( @fields ) { my ( $value ) = $query->param( "$field" ); $fields{ $field } = $value; } # get address part of url $my_url =~ s/^([^\?]*)\?.*$/$1/; my $organisationDescription = getparam( "OrganisationDescription" ); print $fh < 0 ) { $subnetsImmediate++; } if ( $fields{ "RequestOneYear$requestLine" } > 0 ) { $subnetsYear1++; } if ( $fields{ "RequestTwoYear$requestLine" } > 0 ) { $subnetsYear2++; } } # get numbers from free form part of request my @freeRequestPrefix; my @freeRequestMask; my @freeRequestSize; my @freeRequestImmediate; my @freeRequestOneYear; my @freeRequestTwoYear; my @freeRequestDescription; # go through correctly written free form lines, adding to totals # stop at bad or empty one my $freeRequestIndex = 0; while( $fields{ 'FreeFormRequest' } =~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)$/mg ) { $freeRequestPrefix[ $freeRequestIndex ] = $1; $freeRequestMask[ $freeRequestIndex ] = $2; $freeRequestSize[ $freeRequestIndex ] = $3; $freeRequestImmediate[ $freeRequestIndex ] = $4; $freeRequestOneYear[ $freeRequestIndex ] = $5; $freeRequestTwoYear[ $freeRequestIndex ] = $6; $freeRequestDescription[ $freeRequestIndex ] = $7; $totalRequestSize += $freeRequestSize[ $freeRequestIndex ]; $totalRequestImmediate += $freeRequestImmediate[ $freeRequestIndex ]; $totalRequestOneYear += $freeRequestOneYear[ $freeRequestIndex ]; $totalRequestTwoYear += $freeRequestTwoYear[ $freeRequestIndex ]; if ( $freeRequestImmediate[ $freeRequestIndex ] > 0 ) { $subnetsImmediate++; } if ( $freeRequestOneYear[ $freeRequestIndex ] > 0 ) { $subnetsYear1++; } if ( $freeRequestTwoYear[ $freeRequestIndex ] > 0 ) { $subnetsYear2++; } $freeRequestIndex++; } # add explanation fields to yes/no fields... $fields{ "Refused" } = $fields{ "Refused" } . "\n" . $fields{ "WhyRefused" }; $fields{ "Returning" } = $fields{ "Returning" } . "\n" . $fields{ "WhatReturn" }; # ...remove trailing blanks... $fields{ "Refused" } =~ s/\n\s*\Z//mg; # remove trailing blank lines $fields{ "Returning" } =~ s/\n\s*\Z//mg; # remove trailing blank lines # ...and insert labels $fields{ "Refused" } =~ s/^/ request-refused: /mg; $fields{ "Returning" } =~ s/^/ address-space-returned: /mg; # show request overview print $fh <&1 |" ) ) { my $line; while ( $line= ) { if ( $line =~ /^WHOIS_NOTFOUND_REG$/i ) # not found in whois { $found = 0; last; } elsif ( ( $line !~ /^\s*%/ ) && ( $line !~ /^\s*$/ ) ) # not blank or comment { $whoisOutput .= "\t$line"; } if ( $line =~ /^person:.*$/ ) # count the number found { $found += 1; } } close WHOIS; } else { error( "Could not run whois" ); } } print $fh "#[ PERSON TEMPLATE ]#\n\n"; # found how many in whois ? if ( $found == 1 ) # just one found - show em { print $fh $whoisOutput; print $fh "\n"; } else # too many or two few found ? - show entered data { # use entered data # make address multiline into multiple lines my $addressLines = $fields{ "PersonAddress$personLine" }; $addressLines =~ s/^/\taddress: /mg; # show it print $fh <moving $oldfield (" . ( getparam( $oldfield ) ) . ") over $newfield (" . ( getparam( $newfield ) ) . ")
\n" ); $query->param( $newfield, $query->param($oldfield) ); # clear old field $query->param( $oldfield, undef ); return; } #------------------------------------------------------------------------------ # Purpose : print error message if debugging # Side Effects : none # Comments : HTML output sub dprint { my ( $text ) = @_; if ( $debug ) { print $text; } return; } #------------------------------------------------------------------------------ # Purpose : print error message to go in web page # Side Effects : none # Comments : HTML output sub error { my ( $text ) = @_; print "

\nInternal Error: $text

" . 'Please contact the RIPE NCC, mentioning the URL of this page. RIPE NCC

'; return; } __END__ # code end --------------------------------------------------------------------- # POD Help =head1 NAME B - allow user to enter RIPE 141 requests into a web form and convert them to plain text or syntax check them. =head1 SYNOPSIS Perl/CGI script that generates a web form that the user fills out. User can convert the form to plain text RIPE 141 address request, suitable for emailing to RIPE NCC, or syntax check the request with the autohm robot if available. No command line args. =head1 DESCRIPTION When called with no HTML params, will show the empty form for the user to fill out, with the fields mapping to those of the RIPE 141 form. There are buttons to add extra fields which set params telling the code to act differently when these are set. There main buttons set params telling the code to print out a plain text RIPE 141 form based on the data, or to pass the data to the autohm syntax checking robot and show the response in HTML and plain text. If whois is available, it will query that to fill out person objects for given NIC handles. The program will not submit the request to the RIPE NCC. The user must do that by cutting the plain text and pasting it into an email to hostmaster@ripe.net. It may still fail some checks as the autohm robot there does additional checks not done to data submitted by this form. =head1 FILES ripe-141.html - RIPE 141 form specification ripe-142.html - explanation of RIPE 141 form autohm.pl - syntax checker whois - RIPE NCC whois client =head1 REQUIRES Perl5, CGI.pm =head1 BUGS When user press a button to add an extra multi-entry section, the page does not show that section on reloading, but instead returns to the top of the page. This is annoying. =head1 SEE ALSO whois(1), autohm(1), CGI(1) =head1 AUTHOR Maldwyn G.T. Morris =cut