util::archive_has_symlinks (private)

 util::archive_has_symlinks -archive archive

Defined in packages/acs-tcl/tcl/utilities-procs.tcl

Return 1 if the archive contains symbolic link entries, 0 otherwise. Uses bsdtar when available (works for zip and tar), otherwise falls back to: - zipinfo for zip-like archives - tar for tar archives Errors if no suitable inspection tool is available.

Switches:

-archive (required)

Testcases:

No testcase defined.

Source code:

    set archive $archive

    set bsdtarCmd  [util::which bsdtar]
    set unzipCmd   [util::which unzip]
    set zipinfoCmd [util::which zipinfo]
    set tarCmd     [util::which tar]

    set tail [string tolower [file tail $archive]]
    set ext  [string tolower [file extension $tail]]

    #
    # Prefer bsdtar: it can do verbose listing with type info for both
    # tar and zip archives.
    #
    if {$bsdtarCmd ne ""} {
        if {[catch {exec -- $bsdtarCmd -tvf $archive} out]} {
            error "Failed to inspect archive '$archive' for symlinks via bsdtar: $out"
        }
        foreach line [split $out "\n"] {
            if {[string length $line] < 10} {
                continue
            }
            # bsdtar -tvf output starts with mode bits:
            # -rw-r--r--, drwxr-xr-x, lrwxrwxrwx, ...
            set mode [string range $line 0 9]
            if {[string index $mode 0] eq "l"} {
                return 1
            }
        }
        return 0
    }

    #
    # Without bsdtar, fall back to format-specific tools.
    #
    set zipExts {.zip .jar .war .ear .whl}
    set isZip  [expr {$ext in $zipExts}]
    set isTar  0

    if {!$isZip} {
        if {$ext eq ".tar"} {
            set isTar 1
        } elseif {[string match "*.tar.gz" $tail]
                  || [string match "*.tgz" $tail]
                  || [string match "*.tar.bz2" $tail]
                  || [string match "*.tar.xz" $tail]} {
            set isTar 1
        }
    }

    if {$isZip} {
        #
        # ZIP-like: use zipinfo -v and look for "symlink".
        #
        if {$zipinfoCmd ne ""} {
            if {[catch {exec -- $zipinfoCmd -v $archive} out]} {
                error "Failed to inspect zip archive '$archive' for symlinks via zipinfo: $out"
            }
            if {[string match *symlink* $out]} {
                return 1
            }
            return 0
        } elseif {$unzipCmd ne ""} {
            #
            # unzip itself doesn't have a nice verbose format with type info
            # comparable to zipinfo -v, so without zipinfo we can't reliably
            # detect symlinks in a zip archive. Be conservative and error.
            #
            error "Cannot reliably inspect zip archive '$archive' for symlinks: zipinfo not available."
        } else {
            error "No suitable command (zipinfo/unzip/bsdtar) available to inspect zip archive '$archive' for symlinks."
        }
    }

    if {$isTar} {
        #
        # tar archive: tar tvf, same 'l' mode trick as with bsdtar.
        #
        if {$tarCmd eq ""} {
            error "No suitable command (tar/bsdtar) available to inspect tar archive '$archive' for symlinks."
        }
        if {[catch {exec -- $tarCmd tvf $archive} out]} {
            error "Failed to inspect tar archive '$archive' for symlinks via tar: $out"
        }
        foreach line [split $out "\n"] {
            if {[string length $line] < 10} {
                continue
            }
            set mode [string range $line 0 9]
            if {[string index $mode 0] eq "l"} {
                return 1
            }
        }
        return 0
    }

    #
    # Unknown type and no bsdtar.
    #
    error "Unsupported archive type for '$archive'; cannot inspect for symlinks."

XQL Not present:

PostgreSQL, Oracle

Generic XQL file:

packages/acs-tcl/tcl/utilities-procs.xql