Newer
Older
// 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
// %programdata%/mbackup/default-list.txt
// %programdata%/mbackup/user-default-list.txt
// %programdata%/mbackup/local-list.txt (optional)
// %programdata%/mbackup/default-exclude.txt
// %programdata%/mbackup/local-exclude.txt (optional)
open Mbackup.TypedFilePath
let ExitBadParam = 1
let ExitTimeout = 2
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"
| [<AltCommandLine("-n")>] Dry_Run
| Remote_User of remoteUser: string
| [<AltCommandLine("-i")>] Itemize_Changes
| Node_Name of nodeName: 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)))
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
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)
| :? IOException as ex ->
logger.Error "Read/write file failed: %s %s" ex.Source ex.Message
false
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 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
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
match options.TryGetResult Target with
let backupTargetMaybe = rc.Config.GetStr("target")
Option.map normalizeTarget backupTargetMaybe
| Some backupTarget -> Some(normalizeTarget backupTarget)
| 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
| 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
logger.Error "IO Error: %s %s" ex.Source ex.Message
ExitIOError
logger.Error "Unexpected Error: %A" ex