validate file operations

In order to prevent that the presence of malicious symlinks can be used
to escape the allowed_paths, we replace the file command with an alias.
This allows validation of paths during `file normalize` and `file link`
operations, which both resolve symlinks.

genodelabs#99

bin/goa

@@ -24,7 +24,7 @@ proc _find_tool_dir { } {
 	}
 
 	# strip binary name and 'bin/' path
-	return [file dirname [file dirname $path]]
+	return [file dirname [file dirname [file normalize $path]]]
 }
 
 set tool_name [file tail $argv0]

share/goa/lib/command_line.tcl

@@ -67,6 +67,7 @@ proc goa_project_dirs { } {
 	# filter out candidates that are do not look like a real project dir
 	set project_dirs { }
 	foreach dir $project_candidates {
+		set dir [file normalize $dir]
 
 		if {[looks_like_goa_project_dir $dir]} {
 			lappend project_dirs $dir }
@@ -76,12 +77,17 @@ proc goa_project_dirs { } {
 }
 
 
+source [file join $tool_dir lib config.tcl]
+
 #
 # If called with '-r' argument, scan current working directory for
 # project directories and call goa for each project
 #
 if {[consume_optional_cmdline_switch "-r"]} {
 
+	# make sure to populate allowed_paths
+	config::load_privileged_goarc_files
+
 	foreach dir [goa_project_dirs] {
 
 		# assemble command for invoking the per-project execution of goa
@@ -107,8 +113,6 @@ if {[consume_optional_cmdline_switch "-r"]} {
 # Goa was called without '-r' argument, process a single project directory
 #
 
-source [file join $tool_dir lib config.tcl]
-
 diag "process project '$config::project_name' with arguments: $argv"
 
 config load_goarc_files
@@ -126,7 +130,9 @@ foreach var_name [config path_var_names] {
 	set path [consume_optional_cmdline_arg "--$tag_name" ""]
 
 	if {$path != ""} {
-		set config::$var_name [file normalize $path] }
+		set config::$var_name [unsafe_file normalize $path]
+		lappend allowed_paths [set config::$var_name]
+	}
 }
 
 namespace eval config {

share/goa/lib/config.tcl

@@ -4,6 +4,7 @@
 
 namespace eval ::config {
 	namespace export path_var_names load_goarc_files set_late_defaults
+	namespace export load_privileged_goarc_files
 
 	# defaults, potentially being overwritten by 'goarc' files
 	# Note: All variables in this namespace can be overwritten by 'goarc' files
@@ -102,6 +103,70 @@ namespace eval ::config {
 	}
 
 
+	# used as alias for 'file' in main interpreter
+	proc _safe_file { args } {
+		global allowed_paths allowed_tools writeable_paths
+		global config::var_dir config::depot_dir config::public_dir config::project_dir
+
+		proc _validate_path_arg { paths num args } {
+			set target_path [lindex $args $num]
+			if { $target_path == "" } { return }
+
+			# resolve symlinks
+			catch { set target_path [unsafe_file link $target_path] }
+
+			# normalize path
+			set normalized_path [unsafe_file normalize $target_path]
+			if {![_is_sub_directory $normalized_path $paths]} {
+				exit_with_error "Command 'file $args' operates on an invalid path." \
+				                "Valid paths are:\n" \
+				                "\n [join $paths "\n "]" \
+				                "\n\n You may consider setting 'allowed_paths' in" \
+				                "your \$HOME/goarc or /goarc file."
+			}
+		}
+
+		switch [lindex $args 0] {
+			normalize   { _validate_path_arg $allowed_paths 1 {*}$args }
+			executable  { _validate_path_arg $allowed_tools 1 {*}$args }
+			link {
+				set argnum 1
+				set arg [lindex $args $argnum]
+				if {$arg == "-hard" || $arg == "-symbolic"} { incr argnum }
+
+				set writeable_paths [list $depot_dir $public_dir]
+				if {[unsafe_file exists [unsafe_file join $project_dir import]]} {
+					lappend writeable_paths [unsafe_file join $project_dir src]
+					lappend writeable_paths [unsafe_file join $project_dir raw]
+				}
+				if {[info exists var_dir]} {
+					lappend writeable_paths $var_dir }
+
+				_validate_path_arg $writeable_paths $argnum {*}$args
+
+				incr argnum
+				if {[llength $args] > $argnum} {
+					_validate_path_arg [concat $allowed_paths $allowed_tools] $argnum {*}$args }
+			}
+			split       -
+			dirname     -
+			tail        -
+			copy        -
+			delete      -
+			mkdir       -
+			attributes  -
+			isfile      -
+			isdirectory -
+			exists      -
+			join        { }
+			default {
+				exit_with_error "Unknown command 'file $args'" }
+		}
+
+		interp invokehidden {} unsafe_file {*}$args
+	}
+
+
 	# used as alias for 'set' in child interpreter
 	proc _safe_set { rcfile args } {
 		global allowed_paths allowed_tools
@@ -156,7 +221,7 @@ namespace eval ::config {
 	}
 
 
-	proc load_goarc_files {} {
+	proc load_goarc_files { { only_privileged_goarc 0 } } {
 		global tool_dir original_dir config::project_dir
 		global allowed_paths allowed_tools
 
@@ -214,17 +279,26 @@ namespace eval ::config {
 				if {[lsearch -exact $privileged_rcfiles $goarc_path] >= 0} {
 					safeinterp hide  lappend
 					safeinterp alias lappend config::_lappend_allowed_paths safeinterp
+					safeinterp invokehidden source $goarc_file_path
+				} elseif {!$only_privileged_goarc} {
+					safeinterp invokehidden source $goarc_file_path
 				}
-				safeinterp invokehidden source $goarc_file_path
 			}
 		}
 
 		interp delete safeinterp
 
 		# revert original current working directory
 		cd $project_dir
+
+		# hide file command and replace with safe version
+		interp hide {} file unsafe_file
+		interp alias {} file {} config::_safe_file
+		interp alias {} unsafe_file {} interp invokehidden {} unsafe_file
 	}
 
+	proc load_privileged_goarc_files { } { load_goarc_files 1 }
+
 
 	proc set_late_defaults {} {
 		variable project_dir

share/goa/lib/flags.tcl

@@ -17,10 +17,10 @@ foreach api [used_apis] {
 	lappend include_dirs $dir
 }
 
-set libgcc_path    [file normalize [eval "exec $cross_dev_prefix\gcc -print-libgcc-file-name"]]
+set libgcc_path    [unsafe_file normalize [eval "exec $cross_dev_prefix\gcc -print-libgcc-file-name"]]
 set libgcc_include [file join [file dirname $libgcc_path] include]
 
-lappend include_dirs [file normalize $libgcc_include]
+lappend include_dirs [unsafe_file normalize $libgcc_include]
 
 global cppflags
 set cppflags { }