##################
## Module Name     --  disk.tcl
## Original Author --  Emmanuel Frecon - [email protected]
## Description:
##
##      This provides a namespace encapsulated interface to the
##      /dev/disk part of the linux filesystem.  This part of the
##      filesystem provides information about the disks that are
##      currently connected to a computer.  Information such as the
##      labels of the partitions, the UUIDs (generated by linux) for
##      those disks, etc.  All is based on symbolic links between the
##      meta-information level and the target devices.
##
## Commands Exported:
##      find    Find information for a device
##      devices Find devices matching given meta information
##      resolve Recursively resolve symbolic links.
##################


namespace eval ::disk {
    # Encapsulates variables global to this namespace under their own
    # namespace, an idea originating from https://wiki.tcl-lang.org/1489.
    # Variables which name start with a dash are options and which
    # values can be changed to influence the behaviour of this
    # implementation.
    namespace eval vars {
        # Where the /dev/disk filesystem top is placed.
        variable -root   "/dev/disk"
        # How to map from information type to a sub-directory name
        # (subdir or /dev/disk)?  %type% will be replaced by the type
        # of meta information that we are looking for.
        variable -sorter "by-%type%"
        # Types of meta information that can be looked for.
        variable -types  {id label path uuid}
    }
}


# ::disk::find -- Find meta-information for a device.
#
#       Find information for a device and return it.
#
# Arguments:
#        type        Type of information to look for, e.g. id, label or uuid
#        dev        Path to main device (relative or absolute).
#        ptn        Pattern to restrict relevant information with.
#
# Results:
#       Return the name of the file that link to that device.  This
#       name is the meta-information that we were looking for.  Empty
#       string if not found.
#
# Side Effects:
#       By design, look on the disk for information
proc ::disk::find { type dev { ptn * } } {
    # We refuse to look for things that cannot be found
    if { [lsearch ${vars::-types} $type] < 0 } {
        return -code error "$type is an unknown type,\
                            should be one of [join ${vars::-types} ,]"
    }
    # Resolve the incoming dev to where it really points to, so can
    # actually match properly later on.
    set dev [file normalize [resolve $dev]];
    # Get the list of matching files in the directory, these really
    # are links to somewhere else, i.e. to the device that we are
    # looking for.
    set dir [string map [list %type% $type] ${vars::-sorter}]
    set alldisks [glob \
                      -nocomplain \
                      -directory [file join ${vars::-root} $dir] \
                      $ptn]
    # Look for it and return on success.
    foreach f [lsort $alldisks] {
        set dst [file normalize [resolve $f]]
        if { $dst eq $dev } {
            set disk [file tail $f]
            ::utils::debug INFO "Disk which $type points to $dev is: $disk"
            return $disk
        }
    }
    return "";   # Not found
}


# ::disk::devices -- Find devices matching meta-information
#
#       This procedure returns the list of devices matching some
#       meta-information of some type.
#
# Arguments:
#        type        Type of information to look for, e.g. id, label or uuid
#        ptn        Pattern matching the main information
#
# Results:
#       Return the list of fully resolved device path that match the
#       pattern passed as a parameter.
#
# Side Effects:
#       By design, look on the disk for information
proc ::disk::devices { type { ptn * } } {
    # We refuse to look for things that cannot be found
    if { [lsearch ${vars::-types} $type] < 0 } {
        return -code error "$type is an unknown type,\
                            should be one of [join ${vars::-types} ,]"
    }
    # Get the list of matching files in the directory, these really
    # are links to somewhere else, i.e. to the device that we are
    # looking for.
    set dir [string map [list %type% $type] ${vars::-sorter}]
    set alldisks [glob \
                      -nocomplain \
                      -directory [file join ${vars::-root} $dir] \
                      $ptn]
    set devs {}
    foreach f $alldisks {
        lappend devs [file normalize [resolve $f]]
    }
    return $devs
}


# ::disk::resolve -- Resolve links
#
#       Resolve (symbolic) links to their definitive target.
#
# Arguments:
#        path        Path to link (or file/dir).
#        max        Maximum number of iterations when following links.
#
# Results:
#       Return the final target of the link, once all links have been
#       followed. Alt. return where we were in case of infinite loops
#       of links.
#
# Side Effects:
#       By design, look on the disk for information
proc ::disk::resolve { path {max 20}} {
    if { [file type $path] eq "link" } {
        set dst [file join [file dirname $path] [file link $path]]
        incr max -1
        if { $max > 0 } {
            return [resolve $dst $max]
        } else {
            ::utils::debug WARN "Maximum number of iterations reached when\
                                 resolving link!"
            return $path
        }
    }
    return $path
}

::disk::find label /dev/sdb1

::disk::devices label