Program.fs

// Copyright (C) 2019  Yuanle Song <root@emacsos.com>
//
// This file is part of mbackup-for-windows.
//
// mbackup-for-windows is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by the
// Free Software Foundation, either version 3 of the License, or (at your
// option) any later version.
//
// mbackup-for-windows 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 General Public License for
// more details.
//
// You should have received a copy of the GNU General Public License along with
// mbackup-for-windows.  If not, see <http://www.gnu.org/licenses/>.

//
//   - mbackup config file
//     %programdata%/mbackup/mbackup-config.txt
//   - backup file list
//     %programdata%/mbackup/default-list.txt
//     %programdata%/mbackup/user-default-list.txt
//     %programdata%/mbackup/local-list.txt (optional)
//   - exclude pattern
//     %programdata%/mbackup/default-exclude.txt
//     %programdata%/mbackup/local-exclude.txt (optional)

module Mbackup.Program

open System
open System.IO
open System.Diagnostics
open System.Text.RegularExpressions
open System.Diagnostics.CodeAnalysis

open Argu

open Mbackup.Lib
open Mbackup.ConfigParser
open Mbackup.TypedFilePath

let ExitSuccess = 0
let ExitBadParam = 1
let ExitTimeout = 2
let ExitIOError = 3
let ExitUserError = 4

let version = Reflection.Assembly.GetEntryAssembly().GetName().Version
let versionStr = version.ToString()

// base filename for use in mbackup for windows.
// I use .txt and .log extension because user can open/edit them easily.
module MbackupFileName =
    let DefaultList = "default-list.txt"
    let DefaultExclude = "default-exclude.txt"
    let LocalList = "local-list.txt"
    let LocalExclude = "local-exclude.txt"
    let UserDefaultList = "user-default-list.txt"
    let Config = "mbackup-config.txt"

    // run time files
    let GeneratedList = "mbackup-list.txt"
    let Log = "mbackup.log"

[<SuppressMessage("*", "UnionCasesNames")>]
type CLIArguments =
    | [<AltCommandLine("-n")>] Dry_Run
    | Target of backupTarget: string
    | Remote_User of remoteUser: string
    | [<AltCommandLine("-i")>] Itemize_Changes
    | Node_Name of nodeName: string
    | Ssh_Key of sshKeyFilename: string
    | [<AltCommandLine("-V")>] Version
    interface IArgParserTemplate with
        member s.Usage =
            match s with
            | Dry_Run _ -> "only show what will be done, do not transfer any file"
            | Target _ -> "rsync target, could be local dir in Windows or mingw format or remote ssh dir"
            | Remote_User _ -> "remote linux user to own the backup files"
            | Itemize_Changes _ -> "add -i option to rsync"
            | Node_Name _ -> "local node's name, used in remote logging"
            | Ssh_Key _ -> "ssh private key, used when backup to remote ssh node"
            | Version _ -> "show mbackup version and exit"

type MbackupRuntimeConfig =
    { Logger: Logger
      Config: WellsConfig
      Options: ParseResults<CLIArguments> }

let mbackupDir = PortablePath("mbackup")

let programFilesDir = WinPath (Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles))
let mbackupProgramDir = joinPath programFilesDir mbackupDir

let appDataRoamingDir = WinPath (Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData))

let programDataDir = WinPath (getEnv "PROGRAMDATA")
let appDataLocalDir = WinPath (Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData))

let mbackupInstallDir =
    joinPath (WinPath(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles))) mbackupDir

let userHome =
    WinPath(getEnvDefault "HOME" (Environment.GetFolderPath(Environment.SpecialFolder.UserProfile)))
let userHomeMingw = toMingw userHome

let userConfigDir = joinPath programDataDir mbackupDir
let runtimeDir = joinPath appDataLocalDir mbackupDir

// return true if target is a local dir. local dir can be unix style or windows style.
let isLocalTarget (target: string) = target.StartsWith "/" || Regex.IsMatch(target, "^[a-z]:", RegexOptions.IgnoreCase)

// expand user file to mingw64 rsync supported path.
// abc -> /cygdrive/c/Users/<user>/abc
// ^Documents -> expand to Documents path.
// ^Downloads -> expand to Downloads path.
// etc
let expandUserFile (fn: string) =
    let fn =
        let documentsDir =
            toMingwPath(WinPath(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)))
        let picturesDir =
            toMingwPath(WinPath(Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)))
        let desktopDir =
            toMingwPath(WinPath(Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory)))

        let fn = Regex.Replace(fn, "^My Documents/", documentsDir, RegexOptions.IgnoreCase)
        let fn = Regex.Replace(fn, "^Documents/", documentsDir, RegexOptions.IgnoreCase)
        let fn = Regex.Replace(fn, "^我的文档/", documentsDir)
        let fn = Regex.Replace(fn, "^文档/", documentsDir)
        let fn = Regex.Replace(fn, "^My Pictures/", picturesDir, RegexOptions.IgnoreCase)
        let fn = Regex.Replace(fn, "^Pictures/", picturesDir, RegexOptions.IgnoreCase)
        let fn = Regex.Replace(fn, "^图片/", picturesDir)
        let fn = Regex.Replace(fn, "^Desktop/", desktopDir, RegexOptions.IgnoreCase)
        let fn = Regex.Replace(fn, "^桌面/", desktopDir)
        fn
    if fn.StartsWith("/") then fn
    else
      toMingwPath(joinPath userHomeMingw (MingwPath(fn)))

// read mbackup list file
let readMbackupListFile (fn: TypedFilePath) =
    let dropEmptyLinesAndComments lines =
        Seq.filter (fun (line: string) -> not (line.TrimStart().StartsWith("#") || line.TrimEnd().Equals(""))) lines
    File.ReadAllLines(toWinPath fn) |> dropEmptyLinesAndComments

// generate MbackupFileName.GeneratedList file
let generateMbackupList (logger: Logger) =
    // TODO how to only regenerate if source file have changed? should I bundle GNU make with mbackup?
    // just compare MbackupFileName.GeneratedList mtime with its source files?
    let mbackupDefaultList = joinPortablePath userConfigDir MbackupFileName.DefaultList
    let mbackupLocalList = joinPortablePath userConfigDir MbackupFileName.LocalList
    let mbackupUserDefaultList = joinPortablePath userConfigDir MbackupFileName.UserDefaultList
    let mbackupList = joinPortablePath runtimeDir MbackupFileName.GeneratedList

    try
        let defaultListLines = readMbackupListFile mbackupDefaultList |> Seq.map Lib.toMingwPath

        let localListLinesMaybe =
            try
                let lines = readMbackupListFile mbackupLocalList |> Seq.map Lib.toMingwPath
                (true, lines)
            with
            | :? FileNotFoundException -> (true, Seq.empty)
            | ex ->
                logger.Error "Read mbackupLocalList %s failed: %s" (toWinPath mbackupLocalList) ex.Message
                (false, Seq.empty)
        match localListLinesMaybe with
        | (false, _) -> failwith "Read mbackupLocalList failed"
        | (true, localListLines) ->
            let userDefaultListLines = readMbackupListFile mbackupUserDefaultList |> Seq.map expandUserFile
            let allLines = Seq.append (Seq.append defaultListLines localListLines) userDefaultListLines
            // For DefaultList and LocalList, exclude empty lines and comment lines.
            // TODO skip and give a warning on non-absolute path.
            // For UserDefaultList, auto prefix user's home dir, auto expand Documents, Downloads etc special folder.
            Directory.CreateDirectory(toWinPath runtimeDir) |> ignore
            File.WriteAllLines(toWinPath mbackupList, allLines)
            logger.Info "GeneratedList written: %s" (toWinPath mbackupList)
            true
    with
    | :? IOException as ex ->
        logger.Error "Read/write file failed: %s %s" ex.Source ex.Message
        false
    | ex ->
        logger.Error "Read/write mbackup list file failed: %s" ex.Message
        false

exception PrivateKeyNotFoundException of string

let addOptionsForRemoteBackup (rc: MbackupRuntimeConfig) (rsyncCmd: string list) =
    let options = rc.Options
    let sshExeFile = joinPath (toMingw mbackupProgramDir) (MingwPath "rsync-w64/usr/bin/ssh.exe")
    let sshConfigFile = joinPath (toMingw userConfigDir) (MingwPath ".ssh/config")
    let sshKnownHostsFile = joinPath (toMingw userConfigDir) (MingwPath ".ssh/known_hosts")
    let sshPrivateKeyFileDefault = joinPath (toMingw userConfigDir) (MingwPath ".ssh/id_rsa")
    let sshPrivateKeyFile = MingwPath (options.GetResult(Ssh_Key, rc.Config.GetStrDefault "ssh-key" (toString sshPrivateKeyFileDefault)) |> Lib.toMingwPath)
    if not (File.Exists(toWinPath sshPrivateKeyFile)) then
        raise (PrivateKeyNotFoundException("ssh private key doesn't exist: " + toWinPath sshPrivateKeyFile))
    else
        let sshConfigFileOption =
            if File.Exists(toWinPath sshConfigFile) then " -F " + toMingwPath sshConfigFile
            else ""

        let rsyncCmd =
            List.append rsyncCmd
                [ sprintf "-e \"'%s'%s -i %s -o StrictHostKeyChecking=ask -o UserKnownHostsFile=%s\""
                          (toMingwPath sshExeFile) sshConfigFileOption (toMingwPath sshPrivateKeyFile) (toMingwPath sshKnownHostsFile)]

        let nodeName = options.GetResult(Node_Name, (rc.Config.GetStrDefault "node-name" (Net.Dns.GetHostName())))
        let remoteLogFile = sprintf "/var/log/mbackup/%s.log" nodeName
        let remoteUser = options.GetResult(Remote_User, (rc.Config.GetStrDefault "remote-user" Environment.UserName))
        let rsyncCmd = List.append rsyncCmd [ sprintf "--remote-option=--log-file=%s" remoteLogFile ]
        let rsyncCmd = List.append rsyncCmd [ sprintf "--chown=%s:%s" remoteUser remoteUser ]
        rsyncCmd

[<EntryPoint>]
let main argv =
    let logger = Logger()
    let options =
        let errorHandler = ProcessExiter(colorizer = function ErrorCode.HelpText -> None | _ -> Some ConsoleColor.Red)
        let parser = ArgumentParser.Create<CLIArguments>(programName = "mbackup.exe", errorHandler = errorHandler)
        parser.Parse argv
    let rc = {
        MbackupRuntimeConfig.Config =
            let mbackupConfigFile = joinPortablePath userConfigDir MbackupFileName.Config
            WellsConfig(toWinPath mbackupConfigFile)
        Logger = logger
        Options = options
    }

    if options.Contains Version then
        printfn "mbackup %s" versionStr
        Environment.Exit(ExitSuccess)

    logger.Info "user config dir: %s" (toWinPath userConfigDir)
    logger.Info "runtime dir: %s" (toWinPath runtimeDir)
    logger.Debug "program dir: %s" (toWinPath mbackupProgramDir)

    let rsyncCmd: string list = []
    let rsyncCmd = appendWhen (options.Contains Dry_Run) rsyncCmd "--dry-run"
    let rsyncCmd = appendWhen (options.Contains Itemize_Changes) rsyncCmd "-i"
    let rsyncCmd =
        List.append rsyncCmd
            ("-h --stats -togr --delete --delete-excluded --ignore-missing-args".Split [| ' ' |] |> Array.toList)

    if not (generateMbackupList logger) then
        failwith (sprintf "Generate %s failed" MbackupFileName.GeneratedList)
    let generatedFileList = joinPortablePath runtimeDir MbackupFileName.GeneratedList
    let rsyncCmd = List.append rsyncCmd [ sprintf "--files-from=%s" (toMingwPath generatedFileList) ]

    let rsyncCmd = List.append rsyncCmd [ sprintf "--exclude-from=%s" (toMingwPath (joinPortablePath userConfigDir MbackupFileName.DefaultExclude)) ]

    let rsyncCmd =
        let runtimeLocalExcludeFile = joinPortablePath runtimeDir MbackupFileName.LocalExclude
        let localExcludeFile = joinPortablePath userConfigDir MbackupFileName.LocalExclude
        if File.Exists (toWinPath localExcludeFile) then
            let convertAbsPathToMingwStyle (line: string) =
               if Regex.IsMatch(line, "[a-z]:", RegexOptions.IgnoreCase) then
                   Lib.toMingwPath line
               else
                   line
            let lines =
                readMbackupListFile localExcludeFile
                |> Seq.map convertAbsPathToMingwStyle
            File.WriteAllLines(toWinPath runtimeLocalExcludeFile, lines)
        appendWhen (File.Exists (toWinPath localExcludeFile)) rsyncCmd (sprintf "--exclude-from=%s" (toMingwPath runtimeLocalExcludeFile))

    let rsyncCmd = List.append rsyncCmd [ sprintf "--log-file=%s" (toMingwPath (joinPortablePath runtimeDir MbackupFileName.Log)) ]

    // precedence: command line argument > environment variable > config file
    let normalizeTarget target =
        if isLocalTarget target then Lib.toMingwPath target
        else target

    let backupTargetMaybe =
        match options.TryGetResult Target with
        | None ->
            let backupTargetMaybe = rc.Config.GetStr("target")
            Option.map normalizeTarget backupTargetMaybe
        | Some backupTarget -> Some(normalizeTarget backupTarget)

    match backupTargetMaybe with
    | None ->
        logger.Error "TARGET is not defined"
        ExitBadParam
    | Some backupTarget ->
        try
            let rsyncCmd =
                if not (isLocalTarget backupTarget) then
                  addOptionsForRemoteBackup rc rsyncCmd
                else
                  rsyncCmd
            let rsyncCmd = List.append rsyncCmd [ "/" ]
            let rsyncCmd = List.append rsyncCmd [ backupTarget ]
            let rsyncArgs = rsyncCmd |> String.concat " "
            let rsyncExe = joinPath mbackupProgramDir (WinPath "rsync-w64\\usr\\bin\\rsync.exe")
            Directory.CreateDirectory(toWinPath runtimeDir) |> ignore
            Directory.CreateDirectory(toWinPath userConfigDir) |> ignore
            logger.Info
                "Note: if you run the following rsync command yourself, make sure the generated file list (%s) is up-to-date.\n%s"
                (toWinPath generatedFileList) (toWinPath rsyncExe + " " + rsyncArgs)
            let processStartInfo =
                ProcessStartInfo(
                    FileName = toWinPath rsyncExe,
                    Arguments = rsyncArgs)
            //set HOME dir to prevent ssh.exe can't access /home/<user>/.ssh error.
            try
                processStartInfo.EnvironmentVariables.Add("HOME", toWinPath userHome)
                setEnv "HOME" (toWinPath userHome)
            with
            | :? ArgumentException -> ()    // variable already exists
            | ex -> logger.Warning "set HOME environment variable failed: %A" ex
                // not a critical error, allow program to continue.
            let proc = Process.Start(processStartInfo)
            if proc.WaitForExit Int32.MaxValue then
                logger.Info "mbackup exit"
                proc.ExitCode
            else
                logger.Error "mbackup timed out while waiting for rsync to complete"
                ExitTimeout
        with
        | PrivateKeyNotFoundException msg ->
          logger.Error "%s" msg
          logger.Info
            "backup to remote node requires ssh private key, use --ssh-key <existing_key> option or create ~/.ssh/id_rsa file using ssh-keygen"
          ExitUserError
        | :? IOException as ex ->
            logger.Error "IO Error: %s %s" ex.Source ex.Message
            ExitIOError
        | ex ->
            logger.Error "Unexpected Error: %A" ex
            ExitIOError