#
#    Copyright (C) 2010 Alexandros Stergiakis <alsterg@gmail.com>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 of the
#    License, or (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

#//#
# The "fs" module provide commands that operate on local and remote file systems.
#
# Supported local filesystems:
# * Those supported by busybox's applets.
# Supported remote filesystems:
# * NFS
#
#//#

module require base 1.0
module provide fs 1.0

namespace eval ::module::fs {
namespace import ::helper::* ::module::api::*

proc description {} {
    return "Local/Remote filesystem access support"
}

proc version {} {
    
}

proc check_nfs {} {    
    foreach feature [list \
                     CONFIG_NFS_FS \
                     CONFIG_LOCKD \
                     CONFIG_SUNRPC \
                     CONFIG_NFS_COMMON] {
        if {! [::helper::kernel_has $feature]} { ;# Can return error.
            error "Kernel doesn't have support for $feature."
        }
    }
    
    foreach feature [list \
                     CONFIG_FEATURE_MOUNT_NFS] {
        if {! [::helper::busybox_has $feature]} { ;# Can return error.
            error "Busybox doesn't have support for $feature."
        }
    }
    
    exec modprobe sunrpc
    exec modprobe lockd
    exec modprobe nfs
}

proc check {} {
    variable features
    
    foreach feature [list \
                     CONFIG_MD5SUM \
                     CONFIG_SHA1SUM \
                     CONFIG_FSCK \
                     CONFIG_DD \
                     CONFIG_DF \
                     CONFIG_STAT \
                     CONFIG_MOUNT \
                     CONFIG_UMOUNT \
                     CONFIG_SWAPONOFF \
                     CONFIG_MKSWAP \
                     CONFIG_MODPROBE \
                     CONFIG_FDISK] {
        if {! [::helper::busybox_has $feature]} { ;# Can return error.
            error "Busybox doesn't have support for $feature."
        }
    }

    if {[catch {
        check_nfs
    } reason]} {
        log::Notice "Deactivating NFS. Reason: $reason"
    } else {
        lappend features "nfs"
    }
}

proc reset {} {
    variable mounted_swap
    variable mounted_device
    variable mounted_device_map
    variable mounted_nfs
    
    foreach m $mounted_swap {
        exec swapoff $m
    }
    set mounted_swap {}
    
    foreach m $mounted_device {
        exec umount $m
    }
    set mounted_device {}
    array set mounted_device_map {}
    
    foreach m $mounted_nfs {
        lassign $m server remote local
        exec umount -f $local
    }
    set mounted_nfs {}
}

proc constructor {} {
    log::Info "Loading \"fs\" module: [description]"
    
    variable features {}
    variable mounted_swap {}
    variable mounted_device {}
    variable mounted_device_map
    array set mounted_device_map {}
    variable mounted_nfs {}
    
    check

    reset

    # Finally load Command Specs
    sysconf loadspecs "modules/fs/fs.specs"
    
    if {"nfs" in $features} {
        sysconf loadspecs "modules/fs/nfs.specs"
    }
}

proc destructor {} {
    # First unload Command Specs
    sysconf remove "fs"
    
    reset
}

################
# Handlers
################

# Warning: It modifies the working directory for the process.
# This proc is only executed when the "pwd" Tcl command is not accessible (for example in a safe interp),
# otherwise the Tcl command is executed, even if the CLI convenience facilities indicate a MikroConf command.
command Cd {cmdline argstart sid out no arguments args} {
    cd [dict get $arguments DIRECTORY]
    return
}

command More {cmdline argstart sid out no arguments args} {
    foreach f [glob -nocomplain -types {f l} -- [dict get $arguments URL]] {
        sputs [::fileutil::cat $f]
    }
    return
}

command Delete {cmdline argstart sid out no arguments args} {
    file delete -force -- {*}[glob -nocomplain -- [dict get $arguments URL]]
    return
}

command Dir {cmdline argstart sid out no arguments args} {
    if {[dict exists $arguments URL]} {
        set dir [dict get $arguments URL]
        if {[string match {*://} $dir]} {
            append dir *
        }
    } else {
        set dir [file join [pwd] *]
    }
    
    puts "Directory listing for $dir"
    puts [format {%-5s %-11s %-11s %-11s %-s} "Perm" "Bytes" "Access" "Modified" "Name"]
    foreach f [lsort [glob -nocomplain -- $dir]] {
        if {! [file exists $f]} { continue }
        set name [file tail $f]
        if {$name eq "." || $name eq ".."} { continue }
        set perm {}
        if {[file isfile $f]} {append perm "-"}
        if {[file isdirectory $f]} {append perm "d"; append name "/"}
        if {[file readable $f]} {append perm "r"}
        if {[file writable $f]} {append perm "w"}
        if {[file executable $f]} {append perm "e"}
        
        if {[catch { file size $f } size]} { set size "Unavailable" }
        if {[catch { clock format [file atime $f] -format {%Y-%m-%d} } atime]} { set atime "Unavailable" }
        if {[catch { clock format [file mtime $f] -format {%Y-%m-%d} } mtime]} { set mtime "Unavailable" }
        puts [format {%-5s %-11s %-11s %-11s %-s} \
              $perm \
              $size \
              $atime \
              $mtime \
              $name]
}
    return
}

command Mkdir {cmdline argstart sid out no arguments args} {
    file mkdir [dict get $arguments URL]
    return
}

# This proc is only executed when the "pwd" Tcl command is not accessible (for example in a safe interp),
# otherwise the Tcl command is executed, even if the CLI convenience facilities indicate a MikroConf command.
command Pwd {cmdline argstart sid out no arguments args} {
    return [pwd]
}

command Rmdir {cmdline argstart sid out no arguments args} {
    set dirs [glob -nocomplain -type d -- [dict get $arguments URL]]
    foreach d $dirs {
        if {[lempty [glob -nocomplain -- $d]]} {
            file delete -force -- $d
        }
    }
    return
}

# @diff "move" instead of "rename".
command Move {cmdline argstart sid out no arguments args} {
    set sources [getall SOURCE]
    if {[llength $sources] > 1} { ;# Move
        file rename -force -- source {*}$sources [dict get $arguments TARGET]
    } else { ;# Rename
        file rename -force -- $sources [dict get $arguments TARGET]
    }
    return
}

command EraseVolume {cmdline argstart sid out no arguments args} {
    Global DEV_DIR DEVICE_MAPS
    
    set dev [string map $DEVICE_MAPS [dict get $arguments VOLUME]]
    set dev [file join $DEV_DIR $dev]
    
    if {! [file exists $dev]} {
        ferror "cannot find device \"$dev\"" [getpos VOLUME]
    }
    
    exec umount $dev
    
    # Run the following on Slave, for MikroConf to be responsive.
    bgexec dd if=[file join $DEV_DIR zero] of=$dev
    return
}

command Format {cmdline argstart sid out no arguments args} {
    Global DEV_DIR DEVICE_MAPS
    
    set dev [string map $DEVICE_MAPS [dict get $arguments DEVICE]]
    set dev [file join $DEV_DIR $dev]

    if {! [file exists $dev]} {
        ferror "cannot find device" [getpos DEVICE]
    }
    
    set fstype [dict get $arguments FILESYSTEM]
    
    if {$fstype eq "swap"} {
        bgexec mkswap $dev
        return
    }
    
    # Check for availability of the executable.
    if {[lempty [auto_execok mkfs.$fstype]]} {
        ferror "formatting \"$fstype\" filesystem is not supported" [getpos FILESYSTEM]
    }
    
    switch -exact -- $fstype {
        "minix" { set param {-c -n 30 -v} }
        "vfat" {}
        default {
            # No param
        }
    }
    
    # Execute in Slave, for MikroConf to be responsive.
    bgexec mkfs.$fstype {*}$param $dev
    return
}

proc dlist_filesystems {sid args} {
    set fs [list swap]
    if {[::helper::busybox_has CONFIG_MKFS_MINIX]} {
        lappend fs "minix"
    }
    if {[::helper::busybox_has CONFIG_MKFS_VFAT]} {
        lappend fs "vfat"
    }
    return $fs
}

# @interactive
command Fsck {cmdline argstart sid out no arguments args} {
    Global DEV_DIR DEVICE_MAPS
    
    set dev [string map $DEVICE_MAPS [dict get $arguments DEVICE]]
    set dev [file join $DEV_DIR $dev]

    if {! [file exists $dev]} {
        ferror "cannot find device \"$dev\"" [getpos DEVICE]
    }
    
    # Execute in Slave, for MikroConf to be responsive.
    bgexec fsck $dev
    return
}

command ShFileDescriptors {cmdline argstart sid out no arguments args} {
    Global PROC_DIR
    
    if {[dict exists $arguments PID]} {
        set dir [file join $PROC_DIR [dict get $arguments PID] fd]
        if {! [file isdirectory $dir]} {
            ferror "process not found" [getpos PID]
        }
    } else {
        set dir [file join $PROC_DIR [pid] fd]
    }
    
    puts "Open File Descriptors\n"
    puts [format {   %-3s %-s} "FD" "Opened object"]
    set fds [lsort -integer [glob -nocomplain -tails -directory $dir -- *]]
    foreach fd $fds {
        if {! [file exists [file join $dir $fd]]} { continue } ;# We need this because a file descriptor dissapears in the mean time.
        set target [file link [file join $dir $fd]]
        puts [format {   %-3s %-s} $fd $target]
    }
    return
}

command ShFileInformation {cmdline argstart sid out no arguments args} {
    exec stat [dict get $arguments FILEPATH]
}

command ShFileSystem {cmdline argstart sid out no arguments args} {
    if {[dict exists $arguments FILEPATH]} {
        exec stat -f [dict get $arguments FILEPATH]
    } else {
        exec df -P -h
    }
}

command ShDisks {cmdline argstart sid out no arguments args} {
    exec fdisk -l ;# better than /proc/partitions
}

command ShStat {cmdline argstart sid out no arguments args} {
    exec fdisk -l ;# better than /proc/partitions
}

command ShFlash {cmdline argstart sid out no arguments args} {
    # Invoke distribution-specific flash verification code.
    event generate FLASH SHOW $out
    return
}

command VerifyFlash {cmdline argstart sid out no arguments args} {
    # Invoke distribution-specific flash verification code.
    event generate FLASH VERIFY $out
}

proc dlist_devices {sid args} {
    Global DEV_DIR
    glob -nocomplain -directory $DEV_DIR -tail -- sd*
}

command MountSwap {cmdline argstart sid out no arguments args} {
    Global DEV_DIR
    variable mounted_swap
    
    set dev [file join $DEV_DIR [dict get $arguments DEVICE]]
    
    if {$no} {
        if {$dev ni $mounted_swap} {
            ferror "not mounted" [getpos DEVICE]
        }
        exec swapoff $dev
        lremove mounted_swap $dev
    } else {
        if {$dev in $mounted_swap} {
            ferror "already mounted" [getpos DEVICE]
        }
        exec swapon $dev
        lappend mounted_swap $dev
    }
    return
}

proc print_MountSwap {} {
    variable mounted_swap
    
    set result {}
    foreach dev $mounted_swap {
        append result "mount swap $dev\n"
    }
    return $result
}

command MountDevice {cmdline argstart sid out no arguments args} {
    Global DEV_DIR
    variable mounted_device
    variable mounted_device_map
    
    set dev [file join $DEV_DIR [dict get $arguments DEVICE]]
    
    if {$no} {
        if {$dev ni $mounted_device} {
            ferror "not mounted" [getpos DEVICE]
        }
        exec umount $dev
        lremove mounted_device $dev
        unset mounted_device_map($dev)
        return
    }
    
    if {$dev in $mounted_device} {
        ferror "already mounted" [getpos DEVICE]
    }
    
    set dir [dict get $arguments DIRECTORY]
    if {! [file isdirectory $dir]} {
        ferror "not a directory or non-existant directory" [getpos DIRECTORY]
    }
    
    set params {}
    
    if {[dict exists $arguments FILESYSTEM]} {
        set fs [dict get $arguments FILESYSTEM]
        append params "-t $fs "
    } else {
        set fs {}
    }
    
    exec mount {*}$params $dev $dir
    lappend mounted_device $dev
    set mounted_device_map($dev) [dict create directory $dir filesystem $fs]
    return
}

proc print_MountDevice {} {
    variable mounted_device
    variable mounted_device_map
    
    set result {}
    foreach dev $mounted_device {
        set dir [dict get $mounted_device_map($dev) directory]
        set fs [dict get $mounted_device_map($dev) filesystem]
        append result "mount device $dev $dir $fs\n" 
    }
    return $result
}

command MountNfs {cmdline argstart sid out no arguments args} {    
    variable mounted_nfs
    
    set server [dict get $arguments SERVER]
    if {! [isip $server] && ! [ishostname $hostname]} {
        ferror "invalid hostname or address" [getpos SERVER]
    }
    
    set remote [dict get $arguments REMOTE_PATH]
    if {[file pathtype $remote] ne "absolute"} {
        ferror "invalid path; requires an absolute directory path" [getpos REMOTE_PATH]
    }
    
    set local [dict get $arguments LOCAL_PATH]
    if {! [file isdirectory $local]} {
        ferror "not a directory or non-existant directory" [getpos LOCAL_PATH]
    }
    
    set key [list $server $remote $local]
    
    if {$no} {
        if {$key ni $mounted_nfs} {
            error "not mounted"
        }
        
        exec umount -f $local
        lremove mounted_nfs $key
        return
    }
    
    if {$key in $mounted_nfs} {
        error "already mounted"
    }
    
    # bgexec due to DNS resolution and network protocol delays.
    bgexec mount -t nfs ${server}:${remote} $local -o nolock
    lappend mounted_nfs $key
    return
}

proc print_MountNfs {} {
    variable mounted_nfs
    
    set result {}
    foreach m $mounted_nfs {
        lassign $m server remote local
        append result "mount nfs $server $remote $local\n"
    }
    return $result
}

} ;# End of Namespace