Commit 1c3f532f authored by Yuanle Song's avatar Yuanle Song
Browse files

v0.6.3.0 bugfix: local-exclude file should be used 

when it exists.

previously when check whether file exists, mingw style path is used,
which always return false. In this commit, TypedFilePath.fs is added,
all file path is wrapped with TypedFilePath.
parent 528b24ed

Lib.fs

+2 −0
Original line number Diff line number Diff line
@@ -84,6 +84,8 @@ let toMingwPath (windowsPath: string) = 
  result



// Convert Mingw64 path to windows path.

// supported mingwPath format: /cygdrive/x/xxx

// return null if given path is not in this format.

let toWinPath (mingwPath: string) =

  if mingwPath.StartsWith("/cygdrive/") then

    let driveLetter = mingwPath.Substring("/cygdrive/".Length, 1).ToUpper()

Program.fs

+63 −78
Original line number Diff line number Diff line
@@ -38,6 +38,7 @@ open Argu 


open Mbackup.Lib

open Mbackup.ConfigParser

open Mbackup.TypedFilePath



let ExitSuccess = 0

let ExitBadParam = 1
@@ -87,36 +88,25 @@ type MbackupRuntimeConfig = 
      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 mbackupDir = PortablePath("mbackup")



let appDataRoamingDir =

    Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData)

    |> toMingwPath

    |> ensureDir

let programFilesDir = WinPath (Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles))

let mbackupProgramDir = joinPath programFilesDir mbackupDir



let programDataDirWin = getEnv "PROGRAMDATA" |> ensureWinDir

let programDataDir = toMingwPath programDataDirWin

let appDataLocalDirWin = Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData) |> ensureWinDir

let appDataLocalDir = appDataLocalDirWin |> toMingwPath

let appDataRoamingDir = WinPath (Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData))



let mbackupInstallDirWin =

    Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles)

    |> ensureDir

    |> fun s -> s + "mbackup"

let programDataDir = WinPath (getEnv "PROGRAMDATA")

let appDataLocalDir = WinPath (Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData))



let mbackupInstallDir = mbackupInstallDirWin |> toMingwPath

let mbackupInstallDir =

    joinPath (WinPath(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles))) mbackupDir



let userHomeWin =

    getEnvDefault "HOME" (Environment.GetFolderPath(Environment.SpecialFolder.UserProfile)) |> ensureWinDir

let userHome = userHomeWin |> toMingwPath

let userHome =

    WinPath(getEnvDefault "HOME" (Environment.GetFolderPath(Environment.SpecialFolder.UserProfile)))

let userHomeMingw = toMingw userHome



let userConfigDirWin = programDataDirWin + "mbackup\\"

let userConfigDir = programDataDir + "mbackup/"

let runtimeDirWin = appDataLocalDirWin + "mbackup\\"

let runtimeDir = appDataLocalDir + "mbackup/"

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)
@@ -129,17 +119,11 @@ let isLocalTarget (target: string) = target.StartsWith "/" || Regex.IsMatch(targ 
let expandUserFile (fn: string) =

    let fn =

        let documentsDir =

            Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)

            |> toMingwPath

            |> ensureDir

            toMingwPath(WinPath(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)))

        let picturesDir =

            Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)

            |> toMingwPath

            |> ensureDir

            toMingwPath(WinPath(Environment.GetFolderPath(Environment.SpecialFolder.MyPictures)))

        let desktopDir =

            Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory)

            |> toMingwPath

            |> ensureDir

            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)
@@ -152,34 +136,35 @@ let expandUserFile (fn: string) = 
        let fn = Regex.Replace(fn, "^桌面/", desktopDir)

        fn

    if fn.StartsWith("/") then fn

    else userHome + fn

    else

      toMingwPath(joinPath userHomeMingw (MingwPath(fn)))



// read mbackup list file

let readMbackupListFile fn =

let readMbackupListFile (fn: TypedFilePath) =

    let dropEmptyLinesAndComments lines =

        Seq.filter (fun (line: string) -> not (line.TrimStart().StartsWith("#") || line.TrimEnd().Equals(""))) lines

    File.ReadAllLines(fn) |> dropEmptyLinesAndComments

    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 = userConfigDirWin + MbackupFileName.DefaultList

    let mbackupLocalList = userConfigDirWin + MbackupFileName.LocalList

    let mbackupUserDefaultList = userConfigDirWin + MbackupFileName.UserDefaultList

    let mbackupList = runtimeDirWin + MbackupFileName.GeneratedList

    let mbackupDefaultList = joinPortablePath userConfigDir MbackupFileName.DefaultList

    let mbackupLocalList = joinPortablePath userConfigDir MbackupFileName.LocalList

    let mbackupUserDefaultList = joinPortablePath userConfigDir MbackupFileName.UserDefaultList

    let mbackupList = joinPortablePath runtimeDir MbackupFileName.GeneratedList



    try

        let defaultListLines = readMbackupListFile mbackupDefaultList |> Seq.map toMingwPath

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



        let localListLinesMaybe =

            try

                let lines = readMbackupListFile mbackupLocalList |> Seq.map toMingwPath

                let lines = readMbackupListFile mbackupLocalList |> Seq.map Lib.toMingwPath

                (true, lines)

            with

            | :? FileNotFoundException -> (true, Seq.empty)

            | ex ->

                logger.Error "Read mbackupLocalList %s failed: %s" mbackupLocalList ex.Message

                logger.Error "Read mbackupLocalList %s failed: %s" (toWinPath mbackupLocalList) ex.Message

                (false, Seq.empty)

        match localListLinesMaybe with

        | (false, _) -> failwith "Read mbackupLocalList failed"
@@ -189,9 +174,9 @@ let generateMbackupList (logger: Logger) = 
            // 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

            Directory.CreateDirectory(toWinPath runtimeDir) |> ignore

            File.WriteAllLines(toWinPath mbackupList, allLines)

            logger.Info "GeneratedList written: %s" (toWinPath mbackupList)

            true

    with

    | :? IOException as ex ->
@@ -205,22 +190,22 @@ 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 = userConfigDir + ".ssh/config"

    let sshKnownHostsFile = userConfigDir + ".ssh/known_hosts"

    let sshPrivateKeyFile = options.GetResult(Ssh_Key, rc.Config.GetStrDefault "ssh-key" (userConfigDir + ".ssh/id_rsa")) |> toMingwPath

    let sshPrivateKeyFileWin = toWinPath sshPrivateKeyFile

    if not (File.Exists(sshPrivateKeyFileWin)) then

        raise (PrivateKeyNotFoundException("ssh private key doesn't exist: " + sshPrivateKeyFileWin))

    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 " + sshConfigFile

            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\""

                          sshExeFile sshConfigFileOption sshPrivateKeyFile sshKnownHostsFile]

                          (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
@@ -238,8 +223,8 @@ let main argv = 
        parser.Parse argv

    let rc = {

        MbackupRuntimeConfig.Config =

            let mbackupConfigFile = userConfigDirWin + MbackupFileName.Config

            WellsConfig(mbackupConfigFile)

            let mbackupConfigFile = joinPortablePath userConfigDir MbackupFileName.Config

            WellsConfig(toWinPath mbackupConfigFile)

        Logger = logger

        Options = options

    }
@@ -248,9 +233,9 @@ let main argv = 
        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

    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"
@@ -261,31 +246,31 @@ let main argv = 


    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 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" (userConfigDir + MbackupFileName.DefaultExclude) ]

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



    let runtimeLocalExcludeFile = runtimeDir + MbackupFileName.LocalExclude

    let rsyncCmd =

        let localExcludeFile = userConfigDir + MbackupFileName.LocalExclude

        if File.Exists localExcludeFile then

        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

                   toMingwPath line

                   Lib.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)

            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" (runtimeDir + MbackupFileName.Log) ]

    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 toMingwPath target

        if isLocalTarget target then Lib.toMingwPath target

        else target



    let backupTargetMaybe =
@@ -309,20 +294,20 @@ let main argv = 
            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

            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"

                generatedFileList (rsyncExe + " " + rsyncArgs)

                (toWinPath generatedFileList) (toWinPath rsyncExe + " " + rsyncArgs)

            let processStartInfo =

                ProcessStartInfo(

                    FileName = rsyncExe,

                    FileName = toWinPath 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

                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

TypedFilePath.fs

0 → 100644
+60 −0
Original line number Diff line number Diff line 
module Mbackup.TypedFilePath



open System

open System.IO



// use Discriminated Unions to represent windows path and mingw style linux path.

type TypedFilePath =

| WinPath of path: string

| MingwPath of path: string

| PortablePath of path: string



let joinPath (part1: TypedFilePath) (part2: TypedFilePath) =

  match part1 with

  | WinPath(p1) ->

    match part2 with

    | WinPath(p2) | PortablePath(p2) ->

      WinPath(Lib.ensureWinDir(p1) + p2)

    | _ ->

      failwith "Coding error. trying to join different Path type"

  | MingwPath(p1) ->

    match part2 with

    | MingwPath(p2) | PortablePath(p2) ->

      MingwPath(Lib.ensureDir(p1) + p2)

    | _ ->

      failwith "Coding error. trying to join different Path type"

  | _ ->

    failwith "Coding error. joinPath first path should not be PortablePath"



let joinPortablePath (part1: TypedFilePath) (part2: string) =

  joinPath part1 (PortablePath part2)



let toString (tpath: TypedFilePath) =

  match tpath with

  | WinPath(path) | MingwPath(path) | PortablePath(path) -> path



let toWinPath (tpath: TypedFilePath): string =

  match tpath with

  | WinPath(path) | PortablePath(path) -> path

  | MingwPath(path) -> Lib.toWinPath(path)



let toWin (tpath: TypedFilePath): TypedFilePath =

  match tpath with

  | MingwPath(path) -> WinPath(Lib.toWinPath(path))

  | x -> x



let toMingwPath (tpath: TypedFilePath): string =

  match tpath with

  | WinPath(path) | PortablePath(path) -> Lib.toMingwPath(path)

  | MingwPath(path) -> path



let toMingw (tpath: TypedFilePath): TypedFilePath =

  match tpath with

  | WinPath(path) -> MingwPath(Lib.toMingwPath(path))

  | x -> x



let ensureDir (tpath: TypedFilePath) =

  match tpath with

  | WinPath(path) -> WinPath(if path.EndsWith "\\" then path else path + "\\")

  | MingwPath(path) -> MingwPath(if path.EndsWith "/" then path else path + "/")

  | PortablePath(path) -> failwith "Coding error. ensureDir should not be called on PortablePath"

mbackup.fsproj

+2 −1
Original line number Diff line number Diff line
@@ -23,12 +23,13 @@ 
    <RuntimeIdentifiers>win10-x64</RuntimeIdentifiers>

    <RootNamespace>Mbackup</RootNamespace>

    <TreatWarningsAsErrors>true</TreatWarningsAsErrors>

    <Version>0.6.2.0</Version>

    <Version>0.6.3.0</Version>

  </PropertyGroup>



  <ItemGroup>

    <Compile Include="Lib.fs" />

    <Compile Include="ConfigParser.fs" />

    <Compile Include="TypedFilePath.fs" />

    <Compile Include="Program.fs" />

  </ItemGroup>

operational

+14 −5
Original line number Diff line number Diff line
@@ -245,11 +245,6 @@ vscode should at least always indent using space for F#. 


* current                                                             :entry:

** 

** 2019-11-30 bug: mbackup local exclude config is not used in rsync command.

L271 should use win path when check whether file exists.



- can I use typing to specify when a Linux path is required and when a windows

  path is required?

** 2019-11-24 Make sure Chinese file name works in local.list file.

** 2019-11-23 when default .ssh dir is in %programdata%\mbackup\.ssh,

there is a security concern.
@@ -289,6 +284,20 @@ Are there any code change required? 


** 2019-11-18 add log rotate for %localappdata%\mbackup\mbackup.log

* done                                                                :entry:

** 2019-11-30 bug: mbackup local exclude config is not used in rsync command.

L271 should use win path when check whether file exists.



- can I use typing to specify when a Linux path is required and when a windows

  path is required?



  Introduction to functional data types in F#

  https://markvincze.github.io/fsharp-datatypes-intro/#/13



  Discriminated Unions - F# | Microsoft Docs

  https://docs.microsoft.com/en-us/dotnet/fsharp/language-reference/discriminated-unions



- fixed in v0.6.3.0



** 2019-11-30 shipped local list, local exclude file should be in utf-8 encoding.

when user open the file using notepad, it should be in utf-8 encoding.

just add some unicode character in shipped local list file and save in utf-8 encoding