[NetScript CVS] CVS: netscript2/src/perl/NetScript Interpreter.pm,1.11,1.12

[Jan T. <de...@us...>]

Update of /cvsroot/net-script/netscript2/src/perl/NetScript
In directory usw-pr-cvs1:/tmp/cvs-serv19312

Modified Files:
	Interpreter.pm 
Log Message:
* added documentation
* added security settings for foreign hosts

Index: Interpreter.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/perl/NetScript/Interpreter.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Interpreter.pm	11 Jul 2002 22:03:09 -0000	1.11
--- Interpreter.pm	24 Sep 2002 22:22:49 -0000	1.12
***************
*** 15,18 ****
--- 15,34 ----
  # file and then redirects the work to the libraries which are
  # registered.
+ # 
+ # The interpreter delivers two global variables:
+ #   <pre>
+ #       $(SYS.interpreterURL) - URL of the interpreter
+ #       $(SYS.scriptURL) - URL of the currently executed script
+ #   </pre>
+ #   
+ # Also there is a function which can be used to calculate an URL 
+ # relative to the currently executed script:
+ #   <pre>
+ #       url[ url here ]
+ #   </pre>
+ # For example
+ #   <pre>
+ #       &lt;a href=&quot;$(SYS.interpreterURL)?scriptURL=$(url[../myfile.xml])&quot;/&gt;
+ #   </pre>
  #*/
  package NetScript::Interpreter;
***************
*** 25,34 ****
  # The location of the config file.
  #*/
! $CONFIGURATION = "/home/kork/public_html/cgi-bin/netscript2/configuration";
  
  #/**
  # The current Version of NetScript
  #*/
! $VERSION = '2.0pre1';
  
  #/**
--- 41,50 ----
  # The location of the config file.
  #*/
! $CONFIGURATION = "configuration";
  
  #/**
  # The current Version of NetScript
  #*/
! $VERSION = '2.01 beta';
  
  #/**
***************
*** 120,123 ****
--- 136,141 ----
  
      my ($request) = @_;
+     my $configFile = $request -> dir_config( "NetScriptConfigFile" );
+     $CONFIGURATION = $configFile;
  	my $interpreter = NetScript::Interpreter -> new( $request );
  	$interpreter -> run();
***************
*** 137,140 ****
--- 155,160 ----
      bless( $this, $class );             # create Object
  
+     my $config = NetScript::Util::ConfigurationParser -> new( $CONFIGURATION );
+ 
      $this -> { m_Request } = $request;
      $this -> { m_CGI } = new CGI;       # CGI-Member
***************
*** 153,156 ****
--- 173,177 ----
      $this -> { m_ScriptURL } = undef;
      $this -> { m_DOMParser } = XML::DOM2::DOMParser -> new();
+     $this -> { m_Config } = $config;
  
      my @stateTrees = ();
***************
*** 165,169 ****
      $this -> { m_Cookies } = \@cookieList;
  
!     my $libLoader = NetScript::Engine::LibLoader -> new( $this, "/home/kork/public_html/cgi-bin/netscript2/NetScript/Libraries" );
      $this -> { m_LibLoader } = $libLoader;
  
--- 186,197 ----
      $this -> { m_Cookies } = \@cookieList;
  
!     my $libdir = $config -> getSetting( "LIBDIR" );
!     unless ( -e $libdir ) {
!         $this -> getEventRelay() -> createAndRaiseEvent(
!             $FATAL_EVENT, "The configured directory for libraries is:\n\n".
!             "   \"$libdir\",\n".
!             "\nhowever there is no such directory! Please check the configuration file." );
!         }
!     my $libLoader = NetScript::Engine::LibLoader -> new( $this, $libdir );
      $this -> { m_LibLoader } = $libLoader;
  
***************
*** 174,178 ****
      $libLoader -> loadLibrary( "Forms" );
      $libLoader -> loadLibrary( "Class" );
!     
      my $systemWrapper = NetScript::Engine::ClassWrapper -> new( $this );
      $systemWrapper -> setMember( '^interpreterURL$', undef, "getInterpreterURL" );
--- 202,206 ----
      $libLoader -> loadLibrary( "Forms" );
      $libLoader -> loadLibrary( "Class" );
! 
      my $systemWrapper = NetScript::Engine::ClassWrapper -> new( $this );
      $systemWrapper -> setMember( '^interpreterURL$', undef, "getInterpreterURL" );
***************
*** 182,185 ****
--- 210,216 ----
      $this -> getStatementEvaluator() -> createVariable( "SYS", $systemWrapper );
  
+ 
+     # register the relative-URL-function
+     $this -> getStatementEvaluator() -> registerLibraryFunction( "url", $this, "makeURL" );
      # basic init is done - save the global state by putting a new state over it
      $this -> newStateTree();
***************
*** 187,190 ****
--- 218,229 ----
      }
  
+ #/**
+ # Returns the current configuration.
+ # @return an instance of NetScript::Util::ConfigurationParser
+ #*/
+ sub getConfig {
+     my ( $this )  = @_;
+     $this -> { m_Config };
+     }
  
  #/**
***************
*** 223,226 ****
--- 262,292 ----
  
  #/**
+ # Takes the given relative URL and makes it absolute.
+ #*/
+ sub makeURL {
+     my ( $this, $relURL ) = @_;
+     my $currentURL = $this -> getScriptURL();
+     $currentURL =~ /^(.*)\/[^\/]*/;
+     $currentURL = $1."/";
+     
+     while ( $relURL =~ /^\./ ) {
+         if ( $relURL =~ /^\.\./ ) {
+             $currentURL =~ /^(.*)\/[^\/]*\/$/;
+             $currentURL = $1."/";
+             $relURL =~ /^[^\/]*\/(.*)/;
+             $relURL = $1;
+             next;
+             }
+         if ( $relURL =~ /^\./ ) {
+             $relURL =~ /^[^\/]*\/(.*)/;
+             $relURL = $1;
+             next;
+             }
+         }
+     $currentURL .= $relURL;
+     return $currentURL;    
+     }
+ 
+ #/**
  # Sets a cookie in the outgoing response. Since cookies have
  # to be set in the http-header, to which libraries have no access
***************
*** 298,301 ****
--- 364,375 ----
          }
  
+     if ( $script =~ /^http:/ || $script =~ /^ftp:/ ) {
+         unless ( $this -> getConfig() -> getSetting( "ALLOW_REMOTE_SCRIPTS" ) =~ /yes/ ) {
+             $this -> getEventRelay() -> createAndRaiseEvent( 
+                     $FATAL_EVENT, 
+                     "Cannot execute $script,\nlocal security settings forbid to execute scripts from foreign hosts!" );
+             }
+         }
+ 
      $this -> { m_ScriptURL } = $script;
      
***************
*** 304,308 ****
      # start input file parsing
      my $domparser = $this -> { m_DOMParser };
!     my $dom = $domparser -> parseString( $scriptContent );
  
      # Create a DOMWalker
--- 378,395 ----
      # start input file parsing
      my $domparser = $this -> { m_DOMParser };
!     my $dom = undef;
!     eval {
!         $dom = $domparser -> parseString( $scriptContent );
!         };
!     if ( $@ ) {
!         my $string = $@;
!         $string =~ s/&/&amp;/g;
!         $string =~ s/</&lt;/g;
!         $string =~ s/>/&gt;/g;
!         
!         $this -> getEventRelay() -> createAndRaiseEvent( 
!                 $FATAL_EVENT, 
!                 "Error while parsing the input file: " . $string );
!         }
  
      # Create a DOMWalker