develooper Front page | perl.perl5.porters | Postings from July 2001

[PATCH 5.6.1] OS/2 cwd

Thread Next
From:
Ilya Zakharevich
Date:
July 2, 2001 03:21
Subject:
[PATCH 5.6.1] OS/2 cwd
Message ID:
20010702062117.A1401@math.ohio-state.edu
OS/2's cwd() returns the result untained.  Is it a security hole?  The
port uses pdksh for the shell duties...  As perlapi.pod shows, it
would be easy to taint the results of Cwd::sys_cwd(), but is it
actually useful for anything?

This patch

  a) updates os2's Cwd::sys_abspath() to normalize its result (by
     removing trailing and repeated slashes), so it is appropriate as
     a substitution for Cwd::abs_path();

  b) teaches Cwd.pm to make such substitutions ASAP, so a lot of
     useless code is not executed.

     [In fact this ASAP is not as-soon-as-wanted, the proper place for
      this is in a BEGIN block, but I have no idea how to stop loading
      a module (indicating a success) in a BEGIN block...]

     The proper way should be to generated a tuned-to-the-system
     Cwd.pm from ext/Cwd/Cwd_pm.PL.

  c) removes some Win32-isms from FindBin (but not completely - there
     should be a more portable way to do this...);

  d) informs lib/File/Find/taint.t that os2's cwd() is not tainting.

Enjoy,
Ilya

--- ./os2/os2.c-pre-path	Wed Jun 27 23:36:12 2001
+++ ./os2/os2.c	Sun Jul  1 23:14:54 2001
@@ -1971,9 +1971,11 @@ XS(XS_Cwd_sys_abspath)
     {
 	STRLEN n_a;
 	char *	path = (char *)SvPV(ST(0),n_a);
-	char *	dir;
+	char *	dir, *s, *t, *e;
 	char p[MAXPATHLEN];
 	char *	RETVAL;
+	int l;
+	SV *sv;
 
 	if (items < 2)
 	    dir = NULL;
@@ -2063,8 +2065,26 @@ XS(XS_Cwd_sys_abspath)
 	      done:
 	    }
 	}
+	if (!RETVAL)
+	    XSRETURN_EMPTY;
+	/* Backslashes are already converted to slashes. */
+	/* Remove trailing slashes */
+	l = strlen(RETVAL);
+	while (l > 0 && RETVAL[l-1] == '/')
+	    l--;
 	ST(0) = sv_newmortal();
-	sv_setpv((SV*)ST(0), RETVAL);
+	sv_setpvn( sv = (SV*)ST(0), RETVAL, l);
+	/* Remove duplicate slashes */
+	s = t = 1 + SvPV_force(sv, n_a);
+	e = SvEND(sv);
+	while (s < e) {
+	    if (s[0] == t[-1] && s[0] == '/')
+		s++;				/* Skip duplicate / */
+	    else
+		*t++ = *s++;
+	}
+	*s = 0;
+	SvCUR_set(sv, s - SvPVX(sv));
     }
     XSRETURN(1);
 }
--- ./lib/Cwd.pm-pre	Sat Jun  2 09:10:02 2001
+++ ./lib/Cwd.pm	Mon Jul  2 01:47:32 2001
@@ -85,6 +85,25 @@ use base qw/ Exporter /;
 our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
 our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 
+# sys_cwd may keep the builtin command
+
+# All the functionality of this module may provided by builtins,
+# there is no sense to process the rest of the file.
+# The best choice may be to have this in BEGIN, but how to return from BEGIN?
+
+if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
+    local $^W = 0;
+    *cwd		= \&sys_cwd;
+    *getcwd		= \&cwd;
+    *fastgetcwd		= \&cwd;
+    *fastcwd		= \&cwd;
+    *abs_path		= \&sys_abspath;
+    *fast_abs_path	= \&abs_path;
+    *realpath		= \&abs_path;
+    *fast_realpath	= \&abs_path;
+    return 1;
+}
+
 eval {
     require XSLoader;
     XSLoader::load('Cwd');
--- ./lib/FindBin.pm-pre	Sat Jun  2 09:10:08 2001
+++ ./lib/FindBin.pm	Sun Jul  1 17:55:36 2001
@@ -107,15 +107,15 @@ BEGIN
     }
    else
     {
-     my $IsWin32 = $^O eq 'MSWin32';
-     unless(($script =~ m#/# || ($IsWin32 && $script =~ m#\\#))
+     my $doshish = ($^O eq 'MSWin32' or $^O eq 'os2');
+     unless(($script =~ m#/# || ($dosish && $script =~ m#\\#))
             && -f $script)
       {
        my $dir;
        foreach $dir (File::Spec->path)
 	{
         my $scr = File::Spec->catfile($dir, $script);
-	if(-r $scr && (!$IsWin32 || -x _))
+	if(-r $scr && (!$dosish || -x _))
          {
           $script = $scr;
 
--- ./lib/File/Find/taint.t-pre	Sat Jun 23 09:03:18 2001
+++ ./lib/File/Find/taint.t	Sat Jun 30 13:12:16 2001
@@ -34,7 +34,7 @@ foreach my $dir (split(/$sep/,$ENV{'PATH
  }
 $ENV{'PATH'} = join($sep,@path);
 
-my $NonTaintedCwd = $^O eq 'MSWin32' || $^O eq 'cygwin';
+my $NonTaintedCwd = $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'os2';
 
 cleanup();
 

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About