On Linux systems,
/dev/disk organises the various disks that are known and connected to your computer (internal or external) in more user-friendly names. The following package will help querying that information from a script:
## Module Name -- disk.tcl
## Original Author -- Emmanuel Frecon - emmanuel@sics.se
## 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 http://wiki.tcl.tk/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
}So for example, if you have just inserted a USB stick, which is present at
/dev/sdb1, calling the following should return its label (name), provided it has one.
::disk::find label /dev/sdb1
And calling the following would return the devices of all the partitions that are labelled:
::disk::devices label
