[79011] branches/gsoc11-post-destroot/base/src/port1.0/portpostdestroot.tcl

[Ryan Schmidt]

On May 29, 2011, at 21:58, fotanus at macports.org wrote:

> Revision: 79011
>          http://trac.macports.org/changeset/79011
> Author:   fotanus at macports.org
> Date:     2011-05-29 19:58:38 -0700 (Sun, 29 May 2011)
> Log Message:
> -----------
> Added check for symlinks to post-destroot.


> +            if {[regexp $destroot $points_to]} {
> +                ui_debug "Absolute link path poiting to inside of destroot"
> +                return -code error "Absolute link path poiting to inside of destroot"
> +            } else {
> +                ui_debug "Absolute link path poiting to outside of destroot"
> +            }
> +        } elseif { [string compare [file pathtype $points_to] {relative}] == 0 } {
> +            regsub $destroot$prefix/ $link "" link_without_destroot
> +            set dir_depth [regexp -all / $link_without_destroot]
> +            set return_depth [regsub -all {\.\./} $points_to "" points_to_without_returns]
> +            set return_delta [expr $return_depth - [regexp -all / $points_to_without_returns]]
> +            if { $return_delta < $dir_depth } {
> +                ui_debug "Relative link path poiting to inside of destroot"
> +            } else {
> +                ui_debug "Relative link path poiting to outside of destroot"
> +                return -code error "Relative link path poiting to outside of destroot"
> +            }

I think you mean "pointing".