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
......@@ -49,18 +50,25 @@ 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 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
......@@ -82,9 +89,19 @@ let isLocalTarget (target: string) =
// 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 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)
......@@ -95,10 +112,8 @@ let expandUserFile (fn: string) =
let fn = Regex.Replace(fn, "^Desktop/", desktopDir, RegexOptions.IgnoreCase)
let fn = Regex.Replace(fn, "^桌面/", desktopDir)
fn
if fn.StartsWith("/") then
fn
else
userHome + fn
if fn.StartsWith("/") then fn
else userHome + fn
// generate mbackup.list file
let generateMbackupList (logger: Logger) =
......@@ -110,18 +125,19 @@ 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)
| :? FileNotFoundException -> (true, Seq.empty)
| ex ->
logger.Error "Read mbackupLocalList failed: %s" ex.Message
(false, Seq.empty)
......@@ -135,7 +151,9 @@ let generateMbackupList (logger: Logger) =
// 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
logger.Info
"mbackup.list file written: %s"
mbackupList
true
with
| :? System.IO.IOException as ex ->
......@@ -145,9 +163,37 @@ let generateMbackupList (logger: Logger) =
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,11 +208,12 @@ 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"
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"
......@@ -177,49 +224,39 @@ let main argv =
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]
// 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 ->
try
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
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"
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)
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"
......@@ -228,6 +265,11 @@ let main argv =
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
......
......@@ -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.
......