Skip to content
Commits on Source (2)
......@@ -65,5 +65,14 @@ let toMingwPath (windowsPath: string) =
windowsPath
result
// Convert Mingw64 path to windows path.
let toWinPath (mingwPath: string) =
if mingwPath.StartsWith("/cygdrive/") then
let driveLetter = mingwPath.Substring("/cygdrive/".Length, 1).ToUpper()
let rest = mingwPath.Substring("/cygdrive/".Length + 1)
driveLetter + ":" + rest.Replace('/', '\\')
else
null
let ensureDir (path: string) = if path.EndsWith "/" then path else path + "/"
let ensureWinDir (path: string) = if path.EndsWith "\\" then path else path + "\\"
......@@ -11,7 +11,7 @@ help:
@cmd /C echo 'Usage: make [build|test|release|clean|dist|all]'
all: test release dist
dist: mbackup.msi
release:
release: test
dotnet publish --nologo -c Release --self-contained false
test:
dotnet test --nologo mbackup-tests
......
......@@ -24,6 +24,8 @@ open Mbackup.ConfigParser
let ExitBadParam = 1
let ExitTimeout = 2
let ExitIOError = 3
let ExitUserError = 4
[<SuppressMessage("*", "UnionCasesNames")>]
type CLIArguments =
......@@ -33,7 +35,6 @@ type CLIArguments =
| [<AltCommandLine("-i")>] Itemize_Changes
| Node_Name of nodeName: string
| Ssh_Key of sshKeyFilename: string
with
interface IArgParserTemplate with
member s.Usage =
match s with
......@@ -44,23 +45,30 @@ with
| Node_Name _ -> "local node's name, used in remote logging"
| Ssh_Key _ -> "ssh private key, used when backup to remote ssh node"
let programFilesDirWin = Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) |> ensureWinDir
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 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 appDataLocalDirWin = Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) |> ensureWinDir
let appDataLocalDir = appDataLocalDirWin |> toMingwPath
let mbackupInstallDirWin =
Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles)
|> ensureDir
|> fun s -> s + "mbackup"
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
getEnvDefault "HOME" (Environment.GetFolderPath(Environment.SpecialFolder.UserProfile)) |> ensureWinDir
let userHome = userHomeWin |> toMingwPath
......@@ -72,8 +80,7 @@ let runtimeDir = appDataLocalDir + "mbackup/"
let mbackupConfigFile = userConfigDirWin + "mbackup.txt"
// 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, "^[c-z]:", RegexOptions.IgnoreCase)
let isLocalTarget (target: string) = target.StartsWith "/" || Regex.IsMatch(target, "^[c-z]:", RegexOptions.IgnoreCase)
// expand user file to mingw64 rsync supported path.
// abc -> /cygdrive/c/Users/<user>/abc
......@@ -81,24 +88,32 @@ let isLocalTarget (target: string) =
// ^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
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
// generate mbackup.list file
let generateMbackupList (logger: Logger) =
......@@ -110,44 +125,75 @@ let generateMbackupList (logger: Logger) =
let mbackupList = runtimeDirWin + "mbackup.list"
// local functions
let dropEmptyLinesAndComments lines = Seq.filter (fun (line: string) -> not (line.TrimStart().StartsWith("#") || line.TrimEnd().Equals(""))) lines
let dropEmptyLinesAndComments lines =
Seq.filter (fun (line: string) -> not (line.TrimStart().StartsWith("#") || line.TrimEnd().Equals(""))) lines
let readMbackupListFile fn = File.ReadAllLines(fn) |> dropEmptyLinesAndComments
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 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.
Directory.CreateDirectory(runtimeDirWin) |> ignore
File.WriteAllLines(mbackupList, allLines)
logger.Info "mbackup.list file written: %s" mbackupList
true
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 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.
Directory.CreateDirectory(runtimeDirWin) |> ignore
File.WriteAllLines(mbackupList, allLines)
logger.Info
"mbackup.list file written: %s"
mbackupList
true
with
| :? System.IO.IOException as ex ->
logger.Error "Read/write file failed: %s %s" ex.Source ex.Message
false
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
logger.Error "Read/write mbackup list file failed: %s" ex.Message
false
exception PrivateKeyNotFoundException of string
let addOptionsForRemoteBackup (results: ParseResults<CLIArguments>) (logger: Logger) (rsyncCmd: string list) =
let sshExeFile = mbackupProgramDir + "rsync-w64/usr/bin/ssh.exe"
let sshConfigFile = userHome + ".ssh/config"
let sshPrivateKeyFile = results.GetResult(Ssh_Key, defaultValue = 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=no -o UserKnownHostsFile=/dev/null\"" sshExeFile
sshConfigFileOption sshPrivateKeyFile ]
let nodeName = results.GetResult(Node_Name, defaultValue = Net.Dns.GetHostName())
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
[<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
......@@ -162,75 +208,71 @@ let main argv =
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 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]
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 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]
let sshExeFile = mbackupProgramDir + "rsync-w64/usr/bin/ssh.exe"
let sshConfigFile = userHome + ".ssh/config"
let sshPrivateKeyFile = results.GetResult(Ssh_Key, defaultValue = userHome + ".ssh/id_rsa") |> toMingwPath
let rsyncCmd = List.append rsyncCmd [sprintf "-e \"'%s' -F %s -i %s -o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null\"" sshExeFile sshConfigFile sshPrivateKeyFile]
let rsyncCmd = List.append rsyncCmd [ sprintf "--log-file=%s" localLogFile ]
// precedence: command line argument > environment variable > config file
let normalizeTarget target =
if isLocalTarget target then
toMingwPath target
else
target
if isLocalTarget target then toMingwPath target
else target
let backupTargetMaybe =
match results.TryGetResult Target with
| None ->
let mbackupConfig = WellsConfig(mbackupConfigFile)
let backupTargetMaybe = mbackupConfig.GetStr("target")
Option.map normalizeTarget backupTargetMaybe
| Some backupTarget ->
Some (normalizeTarget backupTarget)
| Some backupTarget -> Some(normalizeTarget backupTarget)
match backupTargetMaybe with
| None ->
logger.Error "TARGET is not defined"
ExitBadParam
| Some backupTarget ->
let rsyncCmd =
if not (isLocalTarget backupTarget)
then
let nodeName = results.GetResult(Node_Name, defaultValue = Net.Dns.GetHostName())
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 " "
let rsyncExe = mbackupProgramDirWin + "rsync-w64\\usr\\bin\\rsync.exe"
try
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" mbackupFile (rsyncExe + " " + rsyncArgs)
let proc = Process.Start(rsyncExe, rsyncArgs)
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
let rsyncCmd =
if not (isLocalTarget backupTarget) then
addOptionsForRemoteBackup results logger 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"
mbackupFile (rsyncExe + " " + rsyncArgs)
let proc = Process.Start(rsyncExe, rsyncArgs)
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
logger.Error "IO Error: %s %s" ex.Source ex.Message
ExitIOError
| ex ->
logger.Error "Unexpected Error: %s" ex.Message
ExitIOError
logger.Error "Unexpected Error: %s" ex.Message
ExitIOError
......@@ -27,6 +27,14 @@ let TesttoMingwPath () =
Assert.That("/cygdrive/D/foo", Is.EqualTo(toMingwPath "/D/foo"))
Assert.That("/var/log", Is.EqualTo(toMingwPath "/var/log"))
[<Test>]
let TesttoWinPath () =
Assert.That("C:\\abc\\def", Is.EqualTo(toWinPath "/cygdrive/c/abc/def"))
Assert.That("C:\\abc\\def\\", Is.EqualTo(toWinPath "/cygdrive/c/abc/def/"))
Assert.That("C:\\", Is.EqualTo(toWinPath "/cygdrive/c/"))
Assert.That("D:\\", Is.EqualTo(toWinPath "/cygdrive/d/"))
Assert.That(null, Is.EqualTo(toWinPath "/etc/foo/"))
let mysprintf fmt = sprintf fmt
[<Test>]
......
......@@ -130,6 +130,27 @@ it can only support open a namespace.
using the vscode Ionide-fsharp extension.
* current :entry:
**
** 2019-11-15 f# indent is difficult in vscode.
vscode should at least always indent using space for F#.
- try a code format tool.
GitHub - fsprojects/fantomas: FSharp source code formatter
https://github.com/fsprojects/fantomas
dotnet tool install fantomas-tool -g
- there is context menu > format document.
lonide-fsharp already support it.
format document is on whole buffer. not just selected region.
some code is not formatted properly.
https://code.visualstudio.com/docs/editor/codebasics
Formatting.
Format Document (Ctrl+Shift+I) - Format the entire active file.
Format Selection (Ctrl+K Ctrl+F) - Format the selected text.
but there is not format selection in f# buffer.
** TODO 2019-11-15 additionally support <My Documents>/mbackup/local.list file.
This file is easier to open and backup.
......@@ -194,6 +215,31 @@ Both local.list and local.exclude.
- mbackup.msi works on B75I3 host.
- try mbackup.msi on win 10 VM.
how to require dotnet core 3.0 in .wxs file?
search: wix NetFxExtension symbol for .net core 3
asp.net mvc - Wix package ID for .NET core runtime 1.0.3 - Stack Overflow
https://stackoverflow.com/questions/42908913/wix-package-id-for-net-core-runtime-1-0-3
requires dotnet core 3 runtime on target node.
backup to local dir works.
backup to remote ssh node...works.
- problems
- 2019-11-14T10:50:13 ERROR Read/write file failed: System.Private.CoreLib Could not find a part of the path 'C:\Users\IEUser\AppData\Local\mbackup\mbackup.list'.
Does the dir exist? no. Create it at runtime.
fixed.
- backup to remote ssh node.
Warning: Identity file /cygdrive/c/Users/IEUser/.ssh/id_rsa not accessible: No such file or directory.
Can't open user config file /cygdrive/c/Users/IEUser/.ssh/config: No such file or directory
DONE do not specify config file if it doesn't exist.
DONE fail fast if ssh key doesn't exist. mbackup will only support key based auth.
DONE ssh options should only be added when backup to remote node.
it works.
PS C:\Users\IEUser> &"C:\Program Files\mbackup\publish\mbackup.exe" --target root@sylecn01.emacsos.com:/data/backup/PC-backup/IEUser --ssh-key E:\id_rsa --remote-user sylecn
*now*
- TODO failwith should not be used in UI code. It throws unhandled exception. System.Exception.
search: f# exit early without shifting to the right
in haskell, I use maybeT and eitherT etc.
in f#, you should use exception.
- problems
- each file require it's own <Component> tag.
......