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

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 programFilesDirWin = Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) |> ensureWinDir
let programFilesDir = toMingwPath programFilesDirWin
let mbackupProgramDirWin = programFilesDirWin + "mbackup\\"
let mbackupProgramDir = toMingwPath mbackupProgramDirWin

let appDataRoamingDir =
    Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData)
    |> toMingwPath
    |> ensureDir

let programDataDirWin = getEnv "PROGRAMDATA" |> ensureWinDir
let programDataDir = toMingwPath programDataDirWin
let appDataLocalDirWin = Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) |> ensureWinDir
let appDataLocalDir = appDataLocalDirWin |> toMingwPath

let mbackupInstallDirWin =
    Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles)
    |> ensureDir
    |> fun s -> s + "mbackup"

let mbackupInstallDir = mbackupInstallDirWin |> toMingwPath

let userHomeWin =
    getEnvDefault "HOME" (Environment.GetFolderPath(Environment.SpecialFolder.UserProfile)) |> ensureWinDir
let userHome = userHomeWin |> toMingwPath

let userConfigDirWin = programDataDirWin + "mbackup\\"
let userConfigDir = programDataDir + "mbackup/"
let runtimeDirWin = appDataLocalDirWin + "mbackup\\"
let runtimeDir = appDataLocalDir + "mbackup/"

// 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 =
            Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
            |> toMingwPath
            |> ensureDir
        let picturesDir =
            Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)
            |> toMingwPath
            |> ensureDir
        let desktopDir =
            Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory)
            |> toMingwPath
            |> ensureDir

        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 userHome + fn

// read mbackup list file
let readMbackupListFile fn =
    let dropEmptyLinesAndComments lines =
        Seq.filter (fun (line: string) -> not (line.TrimStart().StartsWith("#") || line.TrimEnd().Equals(""))) lines
    File.ReadAllLines(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 = userConfigDirWin + MbackupFileName.DefaultList
    let mbackupLocalList = userConfigDirWin + MbackupFileName.LocalList
    let mbackupUserDefaultList = userConfigDirWin + MbackupFileName.UserDefaultList
    let mbackupList = runtimeDirWin + MbackupFileName.GeneratedList

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

        let localListLinesMaybe =
            try
                let lines = readMbackupListFile mbackupLocalList |> Seq.map toMingwPath
                (true, lines)
            with
            | :? FileNotFoundException -> (true, Seq.empty)
            | ex ->
                logger.Error "Read mbackupLocalList %s failed: %s" 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(runtimeDirWin) |> ignore
            File.WriteAllLines(mbackupList, allLines)
            logger.Info "GeneratedList written: %s" 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 = mbackupProgramDir + "rsync-w64/usr/bin/ssh.exe"
    let sshConfigFile = userHome + ".ssh/config"
    let sshKnownHostsFile = userHome + ".ssh/known_hosts"
    let sshPrivateKeyFile = options.GetResult(Ssh_Key, rc.Config.GetStrDefault "ssh-key" (userHome + ".ssh/id_rsa")) |> toMingwPath
    let sshPrivateKeyFileWin = toWinPath sshPrivateKeyFile
    if not (File.Exists(sshPrivateKeyFileWin)) then
        raise (PrivateKeyNotFoundException("ssh private key doesn't exist: " + sshPrivateKeyFileWin))
    else
        let sshConfigFileOption =
            if File.Exists(toWinPath sshConfigFile) then " -F " + sshConfigFile
            else ""

        let rsyncCmd =
            List.append rsyncCmd
                [ sprintf "-e \"'%s'%s -i %s -o StrictHostKeyChecking=ask -o UserKnownHostsFile=%s\""
                          sshExeFile sshConfigFileOption sshPrivateKeyFile 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 = userConfigDirWin + MbackupFileName.Config
            WellsConfig(mbackupConfigFile)
        Logger = logger
        Options = options
    }

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

    logger.Info "user config dir: %s" userConfigDirWin
    logger.Info "runtime dir: %s" runtimeDirWin
    logger.Debug "program dir: %s" mbackupProgramDirWin

    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 = runtimeDir + MbackupFileName.GeneratedList
    let rsyncCmd = List.append rsyncCmd [ sprintf "--files-from=%s" generatedFileList ]

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

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

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

    // precedence: command line argument > environment variable > config file
    let normalizeTarget target =
        if isLocalTarget target then 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 = mbackupProgramDirWin + "rsync-w64\\usr\\bin\\rsync.exe"
            Directory.CreateDirectory(runtimeDirWin) |> ignore
            Directory.CreateDirectory(userConfigDirWin) |> 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"
                generatedFileList (rsyncExe + " " + rsyncArgs)
            let processStartInfo =
                ProcessStartInfo(
                    FileName = rsyncExe,
                    Arguments = rsyncArgs)
            //set HOME dir to prevent ssh.exe can't access /home/<user>/.ssh error.
            try
                processStartInfo.EnvironmentVariables.Add("HOME", userHomeWin)
                setEnv "HOME" userHomeWin
            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