Program.fs

// Learn more about F# at http://fsharp.org
//
//   - backup file list
//     /%appdata%/mbackup/mbackup-default.list
//     /%appdata%/mbackup/user-default.list
//     /%appdata%/mbackup/local.list (optional)
//   - exclude pattern
//     /%appdata%/mbackup/mbackup-default.exclude
//     /%appdata%/mbackup/local.exclude (optional)

module Mbackup

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

open Argu

let ExitBadParam = 1
let ExitTimeout = 2
let ExitIOError = 3

[<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
with
    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 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"

type Logger() =
  let mutable level = Logger.DEBUG

  static member DEBUG = 10
  static member INFO = 20
  static member WARNING = 30
  static member ERROR = 40
  static member LevelToString level =
    match level with
      | 10 -> "DEBUG"
      | 20 -> "INFO"
      | 30 -> "WARNING"
      | 40 -> "ERROR"
      | _ -> failwith (sprintf "Unknown log level: %d" level)
  
  member this.Level = level

  member this.LogMaybe level fmt = 
    if this.Level <= level then
      Printf.ksprintf (
        fun s ->
            let time = DateTime.Now
            printfn "%02d:%02d:%02d %s %s" time.Hour time.Minute time.Second (Logger.LevelToString level) s)
        fmt
    else
      Printf.ksprintf (fun _ -> printfn "") fmt

  member this.SetLevel level =
    this.Level = level
  member this.Debug = this.LogMaybe Logger.DEBUG
  member this.Info = this.LogMaybe Logger.INFO
  member this.Warning = this.LogMaybe Logger.WARNING
  member this.Error = this.LogMaybe Logger.ERROR

let GetEnv (varName: string) = Environment.GetEnvironmentVariable varName

let GetEnvDefault (varName: string) (defaultValue: string) =
  let value = Environment.GetEnvironmentVariable varName
  match value with
    | null -> defaultValue
    | "" -> defaultValue
    | _ -> value

// Convert windows path to Mingw64 path.
// Supported windows path: C:\foo, C:/foo, /c/foo
// MingwPath format: /cygdrive/c/foo
let ToMingwPath (windowsPath: string) =
  let pattern = Regex("^/([c-zC-Z])/", RegexOptions.None)
  let result =
    if pattern.IsMatch(windowsPath) then
      "/cygdrive" + windowsPath
    else
      let pattern = Regex("^([c-zC-Z]):", RegexOptions.None)
      if pattern.IsMatch(windowsPath) then
        let result = windowsPath.Replace('\\', '/')
        "/cygdrive/" + result.Substring(0, 1).ToLower() + result.Substring(2)
      else
        windowsPath
  result

let EnsureDir (path: string) = if path.EndsWith "/" then path else path + "/"
let EnsureWinDir (path: string) = if path.EndsWith "\\" then path else path + "\\"

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) |> EnsureDir
let appDataLocalDir =  appDataLocalDirWin|> ToMingwPath

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

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

let isLocalTarget (target: string) = target.StartsWith "/"

// 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
    let userHome = Environment.GetFolderPath(Environment.SpecialFolder.UserProfile) |> ToMingwPath |> EnsureDir
    userHome + fn

// generate mbackup.list file
let generateMbackupList (logger: Logger) =
    // TODO how to only regenerate if source file have changed? should I bundle GNU make with mbackup?
    // just compare mbackup.list mtime with its source files?
    let mbackupDefaultList = userConfigDirWin + "mbackup-default.list"
    let mbackupLocalList = userConfigDirWin + "local.list"
    let mbackupUserDefaultList = userConfigDirWin + "user-default.list"
    let mbackupList = runtimeDirWin + "mbackup.list"

    // local functions
    let dropEmptyLinesAndComments = Seq.filter (fun (line: string) -> not (line.TrimStart().StartsWith("#") || line.TrimEnd().Equals("")))
    let readMbackupListFile fn = File.ReadAllLines(fn) |> dropEmptyLinesAndComments

    try
      let defaultListLines = readMbackupListFile mbackupDefaultList
      let localListLinesMaybe =
        try
          let lines = readMbackupListFile mbackupLocalList
          (true, lines)
        with
          | :? System.IO.FileNotFoundException ->
            (true, Seq.empty)
          | ex ->
            logger.Error "Read mbackupLocalList failed: %s" ex.Message
            (false, Seq.empty)
      match localListLinesMaybe with
        | (false, _) -> failwith "Read mbackup local.list file failed"
        | (true, localListLines) ->
          let userDefaultListLines = readMbackupListFile mbackupUserDefaultList |> Seq.map expandUserFile
          let allLines = Seq.append (Seq.append defaultListLines localListLines) userDefaultListLines
          // For mbackup-default.list and local.list, exclude empty lines and comment lines.
          // skip and give a warning on non-absolute path.
          // For user-default.list, auto prefix user's home dir, auto expand Documents, Downloads etc special folder.
          File.WriteAllLines(mbackupList, allLines)
          logger.Info "%s written" mbackupList
          true
    with
      | ex ->
        logger.Error "Read/write mbackup list file failed: %s" ex.Message
        false

// append string s to list if pred is true
let appendWhen (pred: bool) (lst: string list) (s: string) = if pred then List.append lst [s] else lst

[<EntryPoint>]
let main argv =
    let errorHandler = ProcessExiter(colorizer = function ErrorCode.HelpText -> None | _ -> Some ConsoleColor.Red)
    let parser = ArgumentParser.Create<CLIArguments>(programName = "mbackup.exe", errorHandler = errorHandler)
    let results = parser.Parse argv
    let dryRun = results.Contains Dry_Run
    let itemizeChanges = results.Contains Itemize_Changes

    let logger = Logger()

    logger.Info "userConfigDir=%s" userConfigDir
    logger.Info "runtimeDir=%s" runtimeDir

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

    let mbackupFile = runtimeDir + "mbackup.list"
    if not (generateMbackupList logger) then
      failwith "Generate mbackup.list failed"
    let rsyncCmd = List.append rsyncCmd [sprintf "--files-from=%s" mbackupFile]

    let excludeFile = userConfigDir + "mbackup-default.exclude"
    let rsyncCmd = List.append rsyncCmd [sprintf "--exclude-from=%s" excludeFile]
    let localExcludeFile = userConfigDir + "local.exclude"
    let rsyncCmd = appendWhen (IO.File.Exists localExcludeFile) rsyncCmd (sprintf "--exclude-from=%s" localExcludeFile)

    let localLogFile = runtimeDir + "mbackup.log"
    let rsyncCmd = List.append rsyncCmd [sprintf "--log-file=%s" localLogFile]

    // TODO remove usage of test dir.
    let mbackupInstallDirWinTest = "D:\\downloads\\apps\\mbackupTest\\"
    let mbackupInstallDirTest = mbackupInstallDirWinTest |> ToMingwPath |> EnsureDir
    let sshExeFile = mbackupInstallDirTest + "rsync-w64/usr/bin/ssh.exe"
    let sshConfigFile = userConfigDir + "ssh_config"
    let sshPrivateKeyFile = userConfigDir + "ssh_id_rsa"
    let rsyncCmd = List.append rsyncCmd [sprintf "-e \"%s -F %s -i %s -o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null\"" sshExeFile sshConfigFile sshPrivateKeyFile]

    let backupTarget = results.GetResult (Target, defaultValue = Environment.GetEnvironmentVariable "TARGET")
    match backupTarget with
      | null ->
          logger.Error "TARGET is not defined%s" ""
          ExitBadParam
      | _ ->
          let backupTarget = ToMingwPath backupTarget
          let rsyncCmd =
            if not (isLocalTarget backupTarget)
              then
                let nodeName =
                  match results.GetResult Node_Name with
                    | null ->
                      match GetEnv "NODE_NAME" with
                        | null -> Net.Dns.GetHostName()
                        | X -> X
                    | X -> X
                let remoteLogFile = sprintf "/var/log/mbackup/%s.log" nodeName
                let remoteUser = results.GetResult (Remote_User, defaultValue = 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
              else
                rsyncCmd

          let rsyncCmd = List.append rsyncCmd ["/"]
          let rsyncCmd = List.append rsyncCmd [backupTarget]
          let rsyncArgs = rsyncCmd |> String.concat " "
          // TODO print rsyncArgs in the same Info call when Info supports multiple params.
          logger.Info "Note: if you run the following rsync command yourself, make sure the generated file list (%s) is up-to-date." mbackupFile
          let rsyncExe = mbackupInstallDirWinTest + "rsync-w64\\usr\\bin\\rsync.exe"
          let echoExe = "C:\\Program Files\\Git\\usr\\bin\\echo.exe"
          try
            IO.Directory.CreateDirectory(runtimeDir) |> ignore
            IO.Directory.CreateDirectory(userConfigDir) |> ignore
            let proc = Process.Start(rsyncExe, rsyncArgs)
            logger.Info "%s" (rsyncExe + " " + rsyncArgs)
            if proc.WaitForExit Int32.MaxValue then
              proc.ExitCode
            else
              logger.Error "mbackup timed out while waiting for rsync to complete%s" ""
              ExitTimeout
          with
            | _ ->
              logger.Error "Create runtime dir failed%s" ""
              ExitIOError