From cbb6df35aaeb2333cf38c5a3c8e822931d23b7eb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 29 Jan 2025 18:57:25 -0400 Subject: [PATCH 01/15] merge in doc changes from master --- ..._6f8792b4b31f49712f6707d57a2c3115._comment | 8 + ...past_week__58___Variable_not_in_scope.mdwn | 65 ++++ ...r_seems_to_deadlock_for_huge_worktree.mdwn | 24 +- ..._clone_easily_dead_when_not_intended_.mdwn | 34 ++ ...t-remote-annex_for_directory_on_macOS.mdwn | 362 ++++++++++++++++++ ..._a53bfbd63b3ec5834286167a61d5c4ba._comment | 8 + ..._58ddd2578f115af22e995bd09c2bcea2._comment | 8 + ...__34___creates_local_folder_as_remote.mdwn | 69 ++++ ..._b218e908bd2f897415e6d34137f8536b._comment | 12 + .../polls/prioritizing_special_remotes.mdwn | 2 +- ...een_two_repos_on_the_same_drive__63__.mdwn | 1 + ..._464adfa71d322249dfed4ba65c24995d._comment | 10 + ..._e4cd3108130efbfa796e1ff5e5f55116._comment | 8 + ..._f2069c83af180c7026700a102a528827._comment | 8 + ..._48d98de3582217dcbcdc6b6968c5152d._comment | 8 + ..._051d14d4b7439d10f9879aff505a923c._comment | 8 + ..._ba87cf91217ba01415ff55d33550a75b._comment | 26 ++ ...view_-_git_annex_list_--compact__63__.mdwn | 31 ++ .../Reasonable_annex.bloomcapacity__63__.mdwn | 15 + ..._0361164f67f44520f3af5ba88adc3868._comment | 18 + ..._bfceb1a2ce7d9c70b1c79252a8e12822._comment | 18 + ...reuploads_existing_files_to_bare_repo.mdwn | 5 + ..._427da1bb31bbbcdb88dce5d253e976cc._comment | 24 ++ ..._04946c3d6240ab5a4e0559edab301c1a._comment | 8 + ..._704469f0deb075d0b3c70c73708cd456._comment | 10 + ..._4da905b6b8c0c0ba31f4379bf6d940e0._comment | 8 + ..._2270f72a453d8a75a2e050c82561e4ae._comment | 16 + ..._974bf32abc3d093d6ebcda4838a79553._comment | 44 +++ doc/todo/RawFilePath_conversion.mdwn | 29 +- ..._304b925c5c54b1fd980446920780be00._comment | 70 ++++ ..._5addc5ef9399ffedc23190c9d4e566ce._comment | 24 ++ ..._ddc985546fee804733c4ec485253e98f._comment | 29 ++ ..._b6b1c8e9dc9e1d818036385fd073ed21._comment | 24 ++ ..._f0a575875e1f8809906ba4021e879b43._comment | 11 + ..._573cb6c3ee8d1a2072c61559f81dc32c._comment | 2 +- ..._f1760976e65ae16d4d79f004ac924e55._comment | 27 +- ..._2e10caa2ecbba0f53a3ab031a94c9907._comment | 75 ++++ ..._4641d3ad4a8a8f17f8df47e02555dfa2._comment | 14 + 38 files changed, 1136 insertions(+), 27 deletions(-) create mode 100644 doc/bugs/Can__39__t_export_synced__47___branches/comment_2_6f8792b4b31f49712f6707d57a2c3115._comment create mode 100644 doc/bugs/FTBFS_for_the_past_week__58___Variable_not_in_scope.mdwn create mode 100644 doc/bugs/dead_clone_easily_dead_when_not_intended_.mdwn create mode 100644 doc/bugs/git-remote-annex_for_directory_on_macOS.mdwn create mode 100644 doc/bugs/git_annex_checkpresentkey_removes_git_credentials/comment_3_a53bfbd63b3ec5834286167a61d5c4ba._comment create mode 100644 doc/bugs/git_annex_checkpresentkey_removes_git_credentials/comment_4_58ddd2578f115af22e995bd09c2bcea2._comment create mode 100644 doc/bugs/rsyncurl_without___34____58____34___creates_local_folder_as_remote.mdwn create mode 100644 doc/bugs/rsyncurl_without___34____58____34___creates_local_folder_as_remote/comment_1_b218e908bd2f897415e6d34137f8536b._comment create mode 100644 doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__.mdwn create mode 100644 doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_1_464adfa71d322249dfed4ba65c24995d._comment create mode 100644 doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_2_e4cd3108130efbfa796e1ff5e5f55116._comment create mode 100644 doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_3_f2069c83af180c7026700a102a528827._comment create mode 100644 doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_4_48d98de3582217dcbcdc6b6968c5152d._comment create mode 100644 doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_5_051d14d4b7439d10f9879aff505a923c._comment create mode 100644 doc/forum/How_to_figure_out_why_files_aren__39__t_being_dropped__63__/comment_2_ba87cf91217ba01415ff55d33550a75b._comment create mode 100644 doc/forum/Keeping_the_overview_-_git_annex_list_--compact__63__.mdwn create mode 100644 doc/forum/Reasonable_annex.bloomcapacity__63__.mdwn create mode 100644 doc/forum/Reasonable_annex.bloomcapacity__63__/comment_1_0361164f67f44520f3af5ba88adc3868._comment create mode 100644 doc/forum/b2_rclone_initremote_failed__58___empty_folders/comment_1_bfceb1a2ce7d9c70b1c79252a8e12822._comment create mode 100644 doc/forum/reuploads_existing_files_to_bare_repo.mdwn create mode 100644 doc/forum/reuploads_existing_files_to_bare_repo/comment_1_427da1bb31bbbcdb88dce5d253e976cc._comment create mode 100644 doc/forum/reuploads_existing_files_to_bare_repo/comment_2_04946c3d6240ab5a4e0559edab301c1a._comment create mode 100644 doc/git-annex-dead/comment_1_704469f0deb075d0b3c70c73708cd456._comment create mode 100644 doc/git-annex-dead/comment_2_4da905b6b8c0c0ba31f4379bf6d940e0._comment create mode 100644 doc/git-annex-whereused/comment_4_2270f72a453d8a75a2e050c82561e4ae._comment create mode 100644 doc/special_remotes/git/comment_3_974bf32abc3d093d6ebcda4838a79553._comment create mode 100644 doc/todo/compute_special_remote/comment_10_304b925c5c54b1fd980446920780be00._comment create mode 100644 doc/todo/compute_special_remote/comment_11_5addc5ef9399ffedc23190c9d4e566ce._comment create mode 100644 doc/todo/compute_special_remote/comment_12_ddc985546fee804733c4ec485253e98f._comment create mode 100644 doc/todo/compute_special_remote/comment_13_b6b1c8e9dc9e1d818036385fd073ed21._comment create mode 100644 doc/todo/compute_special_remote/comment_14_f0a575875e1f8809906ba4021e879b43._comment create mode 100644 doc/todo/compute_special_remote/comment_9_2e10caa2ecbba0f53a3ab031a94c9907._comment create mode 100644 doc/todo/generic_p2p_socket_transport/comment_6_4641d3ad4a8a8f17f8df47e02555dfa2._comment diff --git a/doc/bugs/Can__39__t_export_synced__47___branches/comment_2_6f8792b4b31f49712f6707d57a2c3115._comment b/doc/bugs/Can__39__t_export_synced__47___branches/comment_2_6f8792b4b31f49712f6707d57a2c3115._comment new file mode 100644 index 0000000000..8effe18dd5 --- /dev/null +++ b/doc/bugs/Can__39__t_export_synced__47___branches/comment_2_6f8792b4b31f49712f6707d57a2c3115._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="nobodyinperson" + avatar="http://cdn.libravatar.org/avatar/736a41cd4988ede057bae805d000f4f5" + subject="Exporting a synced/* branch works now! 🥳" + date="2025-01-21T18:30:50Z" + content=""" +Thank you very much, I can confirm that it works with git-annex 10.20250116-g8d80b07f5aee368579e04b2acba56a8821eeaab0. 👍 +"""]] diff --git a/doc/bugs/FTBFS_for_the_past_week__58___Variable_not_in_scope.mdwn b/doc/bugs/FTBFS_for_the_past_week__58___Variable_not_in_scope.mdwn new file mode 100644 index 0000000000..14da37c15f --- /dev/null +++ b/doc/bugs/FTBFS_for_the_past_week__58___Variable_not_in_scope.mdwn @@ -0,0 +1,65 @@ +### Please describe the problem. + +I have in my mailbox + +``` + 80 T Jan 26 GitHub Actions *-3.6* (3.7K/0) datalad/git-annex daily summary: 4 FAILED, 8 INCOMPLETE, 1 PASSED, 3 ABSENT + 206 N T Jan 25 GitHub Actions *-3.8* (3.7K/0) datalad/git-annex daily summary: 4 FAILED, 8 INCOMPLETE, 1 PASSED, 3 ABSENT + 357 T Jan 24 GitHub Actions *-4.4* (6.3K/0) datalad/git-annex daily summary: 12 FAILED, 8 INCOMPLETE, 1 PASSED, 3 ABSENT +1279 T Jan 23 GitHub Actions *-4.5* (3.7K/0) datalad/git-annex daily summary: 5 FAILED, 8 INCOMPLETE, 3 ABSENT +1715 T Jan 22 GitHub Actions *-5.0* (3.7K/0) datalad/git-annex daily summary: 5 FAILED, 8 INCOMPLETE, 3 ABSENT 2335 T Jan 21 GitHub Actions *-3.9* (3.7K/0) datalad/git-annex daily summary: 5 FAILED, 8 INCOMPLETE, 3 ABSENT +2656 T Jan 20 GitHub Actions *-4.3* (6.8K/0) datalad/git-annex daily summary: 28 PASSED, 2 ABSENT +2862 T Jan 19 GitHub Actions *-5.0* (6.8K/0) datalad/git-annex daily summary: 28 PASSED, 2 ABSENT +``` + +and looking at the [latest ubuntu build logs](https://github.com/datalad/git-annex/actions/runs/12970824274/job/36176536041) I see + +``` +I: the tail of the log + +Build/LinuxMkLibs.hs:101:17: error: + Variable not in scope: + createDirectoryIfMissing :: Bool -> [Char] -> IO a3 + | +101 | createDirectoryIfMissing True (top ++ libdir takeDirectory d) + | ^^^^^^^^^^^^^^^^^^^^^^^^ + +Build/LinuxMkLibs.hs:149:9: error: + Variable not in scope: + createDirectoryIfMissing :: Bool -> FilePath -> IO a2 + | +149 | createDirectoryIfMissing True (top shimdir) + | ^^^^^^^^^^^^^^^^^^^^^^^^ + +Build/LinuxMkLibs.hs:150:9: error: + Variable not in scope: + createDirectoryIfMissing :: Bool -> FilePath -> IO a1 + | +150 | createDirectoryIfMissing True (top exedir) + | ^^^^^^^^^^^^^^^^^^^^^^^^ + +Build/LinuxMkLibs.hs:160:19: error: + * Variable not in scope: + renameFile :: FilePath -> FilePath -> IO () + * Perhaps you meant `readFile' (imported from Prelude) + | +160 | , renameFile exe exedest + | ^^^^^^^^^^ + +Build/LinuxMkLibs.hs:165:18: error: + Variable not in scope: doesFileExist :: FilePath -> IO Bool + | +165 | unlessM (doesFileExist (top exelink)) $ + | ^^^^^^^^^^^^^ + +Build/LinuxMkLibs.hs:181:9: error: + Variable not in scope: + createDirectoryIfMissing :: Bool -> FilePath -> IO a0 + | +181 | createDirectoryIfMissing True destdir + | ^^^^^^^^^^^^^^^^^^^^^^^^ +make[3]: *** [Makefile:156: Build/Standalone] Error 1 +make[3]: Leaving directory '/home/runner/work/git-annex/git-annex/git-annex-source' +make[2]: *** [Makefile:164: linuxstandalone] Error 2 +``` + diff --git a/doc/bugs/Unlock_filter_seems_to_deadlock_for_huge_worktree.mdwn b/doc/bugs/Unlock_filter_seems_to_deadlock_for_huge_worktree.mdwn index 5530cd570f..b4253cb281 100644 --- a/doc/bugs/Unlock_filter_seems_to_deadlock_for_huge_worktree.mdwn +++ b/doc/bugs/Unlock_filter_seems_to_deadlock_for_huge_worktree.mdwn @@ -4,13 +4,13 @@ I have a pretty big repository with around 300 000 files in the workdir of a bra I wanted to unlock all those files from that branch on a machine, so I tried to use git-annex-adjust --unlock. Sadly, the command do not seems to finish, ever. -Executing the command with debug from a clone(to avoid interacting with the broken index from the first), it seems to deadlock after executing between 10000 and 20000 "thawing" processes when executing the filter-process logic over the files in the worktree. -The problem seems to be reproducible with any repository with a lot of files in the worktree as far as I can tell, independant of file size. +Executing the command with the debug flag from a clone(to avoid interacting with the broken index from the first), it seems to deadlock after executing 10240 completed processes for the filter-process logic over the files in the worktree, which happens to match the annex.queuesize configuration value in use in those repositories. +The problem seems to be reproducible with any repository with more than the aforementioned count of files in the worktree as far as I can tell, independant of file size. -The deadlock described makes higher-level commands like git annex sync also block indefinitely when checkout-ing the unlocked branch for any reason. +The deadlock described makes higher-level commands like git annex sync also block indefinitely when checkout-ing the unlocked branch for any reason in these kinds of unlocked repository du to implcit call to the deadlocking git-annex smudge code. Also, because the filtering is not completely applied, the index is pretty scrambled, its easier to clone the repo and move the annex than fix it, for me at least. -I call the behavior "deadlock" due to the absence of debug log output and low cpu usage on the process when in that state. This seems to indicate some kind of multiprocessing deadlock to me. +I call the behavior "deadlock" due to the absence of debug log output after the 10240 th process and 0% cpu usage on the remaining git and git-annex processes when the bug happens. This seems to indicate some kind of multiprocessing deadlock to me. ### What steps will reproduce the problem? @@ -27,10 +27,13 @@ Here is a minimum set of bash commands that generate the deadlock on my end: git annex add git commit -m "add all empty files" - # This will get stuck after around ~10000-20000 processes from Utility.Process in the debug log while the git annex thaws files into unlocked files - # The deadlock seems to happens after outputing the start of a new thawing, ctrl-c seems to be the only end state for this - git annex adjust --unlock --debug + # This will get stuck after 10240 processes from Utility.Process completed in the debug log while git annex thaws files into unlocked files + # The deadlock seems to happens after outputing the start of the last thawing in the queue, ctrl-c seems to be the only end state for this + git annex adjust --unlock --debug 2> ~/unlock-log + # Ctrl-c the command above once the debug output cease to output new lines without exiting. + # This commands output the number of processes ran for the command above, which is 10240 for me + cat ~/unlock-log | grep Perms | wc -l ### What version of git-annex are you using? On what operating system? @@ -64,14 +67,15 @@ Debian Bookworm [Compiled via "building from source on Debian"] ### Please provide any additional information below. -Excerpt of the last lines from the huge debug log: +Excerpt of the last lines from the huge debug log from the git annex adjust above: [2025-01-16 23:30:27.913022014] (Utility.Process) process [493397] done ExitSuccess [2025-01-16 23:30:27.91309169] (Annex.Perms) thawing content .git/annex/othertmp/BKQKGR.0/BKQKGR -Given the huge debug log produced, it may be easier to reproduce the bug to have it than copying it here. If wanted, I can generate one as required. +Given the huge debug log produced for this bug, it may be easier to reproduce the bug to have it than copying it here. If wanted, I can generate one as required with the process documented in for the bug repoduction above. -Repeatedly calling this(and ctrl-c it when it inevitably get stuck) seems to eventually unlock the files, but its not really a valid solution in my case. + +Repeatedly calling this(and ctrl-c it when it inevitably get stuck) seems to eventually unlock the files ion batches of 10240, but its not really a valid solution in my case. git annex smudge --update --debug diff --git a/doc/bugs/dead_clone_easily_dead_when_not_intended_.mdwn b/doc/bugs/dead_clone_easily_dead_when_not_intended_.mdwn new file mode 100644 index 0000000000..c6b79764cf --- /dev/null +++ b/doc/bugs/dead_clone_easily_dead_when_not_intended_.mdwn @@ -0,0 +1,34 @@ +### Please describe the problem. + +Current syntax of `dead` online at git annex dead [repository ...] [--key somekey ...] says + +`git annex dead [repository ...] [--key somekey ...]` + +which is also incorrect rendering I think since it is + +``` +[d31548v@ndoli tmp]$ git annex dead --help +git-annex dead - hide a lost repository or key + +Usage: git-annex dead [[REPOSITORY ...] | [--key KEY]] + +``` + +so it is EITHER to announce REPOSITORY or a KEY. + +Naive/new/quick users, since many annex commands take file paths as arguments could provide `dead` with both - repository and local paths, e.g. `git annex dead here */*.nii.gz` or alike. But then annex proceeds with marking `here` dead while then erroring out on paths: + +```shell +(datalad-dev) [d78092t@ndoli 1080_wasabi]$ git-annex dead here sub-SID000743/ses-01/func/*.nii +dead here (recording state in git...) +ok +git-annex: there is no available git remote named "sub-SID000743/ses-01/func/sub-SID000743_ses-01_task-hyperalignment_acq-mb8_run-04_bold.nii" +``` + +which is correct/expected behavior given the fact that if RTFM then those are to be taken as repositories. + +But I wondered if may be `git annex` could/should become more "protective" and fail early if any of provided repositories is "not available"? + + +[[!meta author=yoh]] +[[!tag projects/openneuro]] diff --git a/doc/bugs/git-remote-annex_for_directory_on_macOS.mdwn b/doc/bugs/git-remote-annex_for_directory_on_macOS.mdwn new file mode 100644 index 0000000000..435fce443d --- /dev/null +++ b/doc/bugs/git-remote-annex_for_directory_on_macOS.mdwn @@ -0,0 +1,362 @@ +### Please describe the problem. +Running `git-annex enableremote local1 --with-url` for directory special remote `local` fails on macOS. + +Trying to sync to directory special remote configured manually as git-remote-annex fails on macOS. + +### What steps will reproduce the problem? +[[!format sh """ +% pwd +/tmp/git-annex-testing +% mkdir repo +% cd repo +% git init +% git annex init +% echo "file a" > a.txt +% echo "file b" > b.txt +% git annex add a.txt +% git annex add b.txt +% git commit -m "added files" +% git annex info +... +local annex keys: 2 +local annex size: 14 bytes +annexed files in working tree: 2 +.. +% mkdir ../specialdirectoryremote +% git annex initremote local1 type=directory directory=/tmp/git-annex-testing/specialdirectoryremote encryption=none +initremote local1 ok +(recording state in git...) +% git annex copy --to=local1 +% git annex info local1 +uuid: 7d7560cd-2e80-489d-af4a-ec23b9b9abb7 +description: [local1] +trust: semitrusted +remote: local1 +cost: 100.0 +type: directory +available: true +directory: /tmp/git-annex-testing/specialdirectoryremote +encryption: none +chunking: none +remote annex keys: 2 +remote annex size: 14 bytes +% git-annex enableremote local1 --with-url +enableremote local1 +git-annex: Specify directory= +failed +enableremote: 1 failed +"""]] + + +### What version of git-annex are you using? On what operating system? +[[!format sh """ +% git --version +git version 2.48.0 +% git-annex version +git-annex version: 10.20250103-gbd5d7e936d15abc1376f64ea9a124bba0b6e2d11 +build flags: Assistant Webapp Pairing FsEvents TorrentParser MagicMime Servant Benchmark Feeds Testsuite S3 WebDAV +dependency versions: aws-0.24.3 bloomfilter-2.0.1.2 crypton-1.0.1 DAV-1.3.4 feed-1.3.2.1 ghc-9.8.4 http-client-0.7.18 persistent-sqlite-2.13.3.0 torrent-10000.1.3 uuid-1.3.16 yesod-1.6.2.1 +key/value backends: SHA256E SHA256 SHA512E SHA512 SHA224E SHA224 SHA384E SHA384 SHA3_256E SHA3_256 SHA3_512E SHA3_512 SHA3_224E SHA3_224 SHA3_384E SHA3_384 SKEIN256E SKEIN256 SKEIN512E SKEIN512 BLAKE2B256E BLAKE2B256 BLAKE2B512E BLAKE2B512 BLAKE2B160E BLAKE2B160 BLAKE2B224E BLAKE2B224 BLAKE2B384E BLAKE2B384 BLAKE2BP512E BLAKE2BP512 BLAKE2S256E BLAKE2S256 BLAKE2S160E BLAKE2S160 BLAKE2S224E BLAKE2S224 BLAKE2SP256E BLAKE2SP256 BLAKE2SP224E BLAKE2SP224 SHA1E SHA1 MD5E MD5 WORM URL GITBUNDLE GITMANIFEST VURL X* +remote types: git gcrypt p2p S3 bup directory rsync web bittorrent webdav adb tahoe glacier ddar git-lfs httpalso borg rclone hook external +operating system: darwin x86_64 +supported repository versions: 8 9 10 +upgrade supported from repository versions: 0 1 2 3 4 5 6 7 8 9 10 +local repository version: 10 +% sw_vers +ProductName: macOS +ProductVersion: 12.6.3 +BuildVersion: 21G419 +% uname -a +Darwin bumblebee.local 21.6.0 Darwin Kernel Version 21.6.0: Mon Dec 19 20:46:01 PST 2022; root:xnu-8020.240.18~2/RELEASE_ARM64_T8101 arm64 +% +"""]] + +### Please provide any additional information below. + +[[!format sh """ +% git --version +git version 2.48.0 +% git-annex version +git-annex version: 10.20250103-gbd5d7e936d15abc1376f64ea9a124bba0b6e2d11 +build flags: Assistant Webapp Pairing FsEvents TorrentParser MagicMime Servant Benchmark Feeds Testsuite S3 WebDAV +dependency versions: aws-0.24.3 bloomfilter-2.0.1.2 crypton-1.0.1 DAV-1.3.4 feed-1.3.2.1 ghc-9.8.4 http-client-0.7.18 persistent-sqlite-2.13.3.0 torrent-10000.1.3 uuid-1.3.16 yesod-1.6.2.1 +key/value backends: SHA256E SHA256 SHA512E SHA512 SHA224E SHA224 SHA384E SHA384 SHA3_256E SHA3_256 SHA3_512E SHA3_512 SHA3_224E SHA3_224 SHA3_384E SHA3_384 SKEIN256E SKEIN256 SKEIN512E SKEIN512 BLAKE2B256E BLAKE2B256 BLAKE2B512E BLAKE2B512 BLAKE2B160E BLAKE2B160 BLAKE2B224E BLAKE2B224 BLAKE2B384E BLAKE2B384 BLAKE2BP512E BLAKE2BP512 BLAKE2S256E BLAKE2S256 BLAKE2S160E BLAKE2S160 BLAKE2S224E BLAKE2S224 BLAKE2SP256E BLAKE2SP256 BLAKE2SP224E BLAKE2SP224 SHA1E SHA1 MD5E MD5 WORM URL GITBUNDLE GITMANIFEST VURL X* +remote types: git gcrypt p2p S3 bup directory rsync web bittorrent webdav adb tahoe glacier ddar git-lfs httpalso borg rclone hook external +operating system: darwin x86_64 +supported repository versions: 8 9 10 +upgrade supported from repository versions: 0 1 2 3 4 5 6 7 8 9 10 +local repository version: 10 +% sw_vers +ProductName: macOS +ProductVersion: 12.6.3 +BuildVersion: 21G419 +% uname -a +Darwin bumblebee.local 21.6.0 Darwin Kernel Version 21.6.0: Mon Dec 19 20:46:01 PST 2022; root:xnu-8020.240.18~2/RELEASE_ARM64_T8101 arm64 +% + + +% pwd +/tmp/git-annex-testing +% mkdir repo +% cd repo +% git init +% git annex init +% echo "file a" > a.txt +% echo "file b" > b.txt +% git annex add a.txt +% git annex add b.txt +% git commit -m "added files" +% git annex info +... +local annex keys: 2 +local annex size: 14 bytes +annexed files in working tree: 2 +.. +% mkdir ../specialdirectoryremote +% git annex initremote local1 type=directory directory=/tmp/git-annex-testing/specialdirectoryremote encryption=none +initremote local1 ok +(recording state in git...) +% git annex copy --to=local1 +% git annex info local1 +uuid: 7d7560cd-2e80-489d-af4a-ec23b9b9abb7 +description: [local1] +trust: semitrusted +remote: local1 +cost: 100.0 +type: directory +available: true +directory: /tmp/git-annex-testing/specialdirectoryremote +encryption: none +chunking: none +remote annex keys: 2 +remote annex size: 14 bytes +% git-annex enableremote local1 --with-url +enableremote local1 +git-annex: Specify directory= +failed +enableremote: 1 failed + +% git config set annex.debug true +% git-annex enableremote local1 --with-url +[2025-01-28 12:38:26.198647] (Utility.Process) process [13595] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","git-annex"] +[2025-01-28 12:38:26.206976] (Utility.Process) process [13595] done ExitSuccess +[2025-01-28 12:38:26.209633] (Utility.Process) process [13596] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--hash","refs/heads/git-annex"] +[2025-01-28 12:38:26.216084] (Utility.Process) process [13596] done ExitSuccess +[2025-01-28 12:38:26.220051] (Utility.Process) process [13597] chat: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","cat-file","--batch"] +enableremote local1 +git-annex: Specify directory= +failed +[2025-01-28 12:38:26.228828] (Utility.Process) process [13597] done ExitSuccess +enableremote: 1 failed +% + + +% git config remote.local1.url annex:: +% git config remote.local1.fetch '+refs/heads/*:refs/remotes/foo/*' + + + +% git push --set-upstream local1 master +[2025-01-28 12:45:05.935101] (Utility.Process) process [20178] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","git-annex"] +[2025-01-28 12:45:05.941251] (Utility.Process) process [20178] done ExitSuccess +[2025-01-28 12:45:05.943896] (Utility.Process) process [20179] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--hash","refs/heads/git-annex"] +[2025-01-28 12:45:05.950867] (Utility.Process) process [20179] done ExitSuccess +[2025-01-28 12:45:05.95425] (Utility.Process) process [20180] chat: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","cat-file","--batch"] +Full remote url: annex::7d7560cd-2e80-489d-af4a-ec23b9b9abb7?encryption=none&type=directory +[2025-01-28 12:45:05.96577] (Utility.Process) process [20181] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","for-each-ref","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/","--format=%(objectname) %(refname)"] +[2025-01-28 12:45:05.973785] (Utility.Process) process [20181] done ExitSuccess +[2025-01-28 12:45:05.976602] (Utility.Process) process [20182] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--hash","refs/heads/master"] +[2025-01-28 12:45:05.983816] (Utility.Process) process [20182] done ExitSuccess +[2025-01-28 12:45:05.986197] (Utility.Process) process [20183] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","for-each-ref","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/","--format=%(objectname) %(refname)"] +[2025-01-28 12:45:05.992446] (Utility.Process) process [20183] done ExitSuccess +[2025-01-28 12:45:05.994823] (Utility.Process) process [20184] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","update-ref","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/refs/heads/master","cee403c71ad8d180c149c26818b268b4fba67c3f"] +[2025-01-28 12:45:06.002395] (Utility.Process) process [20184] done ExitSuccess +[2025-01-28 12:45:06.006364] (Utility.Process) process [20185] feed: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","bundle","create","--quiet","/var/folders/2p/4z266zp97g9f0w5xxx4hkjz40000gn/T/GITBUNDLE20173-0","--stdin"] +[2025-01-28 12:45:06.027734] (Utility.Process) process [20185] done ExitSuccess +[2025-01-28 12:45:06.028831] (Annex.Perms) freezing content .git/annex/objects/30/fM/GITBUNDLE-s595--7d7560cd-2e80-489d-af4a-ec23b9b9abb7-9aca839242a1231b8ea7d6c4544a582da92ec8a345a87d1f9ec2e7ac9c57917d/GITBUNDLE-s595--7d7560cd-2e80-489d-af4a-ec23b9b9abb7-9aca839242a1231b8ea7d6c4544a582da92ec8a345a87d1f9ec2e7ac9c57917d +[2025-01-28 12:45:06.032936] (Annex.Perms) freezing content directory .git/annex/objects/30/fM/GITBUNDLE-s595--7d7560cd-2e80-489d-af4a-ec23b9b9abb7-9aca839242a1231b8ea7d6c4544a582da92ec8a345a87d1f9ec2e7ac9c57917d +[2025-01-28 12:45:06.035315] (Utility.Process) process [20187] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","symbolic-ref","-q","HEAD"] +[2025-01-28 12:45:06.041878] (Utility.Process) process [20187] done ExitSuccess +[2025-01-28 12:45:06.044996] (Utility.Process) process [20188] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","refs/heads/master"] +[2025-01-28 12:45:06.051196] (Utility.Process) process [20188] done ExitSuccess +[2025-01-28 12:45:06.053205] (Utility.Process) process [20180] done ExitSuccess +[2025-01-28 12:45:06.057349] (Utility.Process) process [20191] call: cp ["-a","/var/folders/2p/4z266zp97g9f0w5xxx4hkjz40000gn/T/GITMANIFEST20173-3",".git/annex/objects/9q/z3/GITMANIFEST--7d7560cd-2e80-489d-af4a-ec23b9b9abb7.bak/GITMANIFEST--7d7560cd-2e80-489d-af4a-ec23b9b9abb7.bak"] +[2025-01-28 12:45:06.057467] (Utility.Process) process [20191] done ExitFailure (-9) +[2025-01-28 12:45:06.05756] (Annex.Perms) freezing content directory .git/annex/objects/9q/z3/GITMANIFEST--7d7560cd-2e80-489d-af4a-ec23b9b9abb7.bak +Push failed (Failed to upload manifest.) +[2025-01-28 12:45:06.06058] (Utility.Process) process [20192] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","for-each-ref","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/","--format=%(objectname) %(refname)"] +[2025-01-28 12:45:06.068669] (Utility.Process) process [20192] done ExitSuccess +[2025-01-28 12:45:06.071203] (Utility.Process) process [20193] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","update-ref","-d","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/refs/heads/master","cee403c71ad8d180c149c26818b268b4fba67c3f"] +[2025-01-28 12:45:06.078439] (Utility.Process) process [20193] done ExitSuccess +warning: helper reported unexpected status of push +Everything up-to-date +[2025-01-28 12:45:06.081082] (Utility.Process) process [20194] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","git-annex"] +[2025-01-28 12:45:06.0879] (Utility.Process) process [20194] done ExitSuccess +[2025-01-28 12:45:06.090302] (Utility.Process) process [20195] read: git ["--version"] +[2025-01-28 12:45:06.095789] (Utility.Process) process [20195] done ExitSuccess +[2025-01-28 12:45:06.096182] (Annex.Perms) freezing content .git/annex/misctmp/gaprobe +[2025-01-28 12:45:06.096262] (Annex.Perms) thawing content .git/annex/misctmp/gaprobe +[2025-01-28 12:45:06.09862] (Utility.Process) process [20196] chat: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","cat-file","--batch"] +% exit +% git config unset annex.debug +% git push --set-upstream local1 master +Full remote url: annex::7d7560cd-2e80-489d-af4a-ec23b9b9abb7?encryption=none&type=directory +Push failed (Failed to upload manifest.) +warning: helper reported unexpected status of push +Everything up-to-date +% git annex sync +commit +On branch master +nothing to commit, working tree clean +ok +pull local1 +Full remote url: annex::7d7560cd-2e80-489d-af4a-ec23b9b9abb7?encryption=none&type=directory +git-annex: No git repository found in this remote. +ok +push local1 +Full remote url: annex::7d7560cd-2e80-489d-af4a-ec23b9b9abb7?encryption=none&type=directory +Push failed (Failed to upload manifest.) +warning: helper reported unexpected status of push +warning: helper reported unexpected status of push +Everything up-to-date +ok +% git config set annex.debug true +% git annex sync +[2025-01-28 12:46:47.892399] (Utility.Process) process [22027] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","git-annex"] +[2025-01-28 12:46:47.898879] (Utility.Process) process [22027] done ExitSuccess +[2025-01-28 12:46:47.901826] (Utility.Process) process [22028] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--hash","refs/heads/git-annex"] +[2025-01-28 12:46:47.908197] (Utility.Process) process [22028] done ExitSuccess +[2025-01-28 12:46:47.911039] (Utility.Process) process [22029] chat: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","cat-file","--batch"] +commit +[2025-01-28 12:46:47.92136] (Utility.Process) process [22030] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","commit","-a","-m","git-annex in andrew:/private/tmp/git-annex-testing/repo"] +[2025-01-28 12:46:47.981547] (Utility.Process) process [22035] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","symbolic-ref","-q","HEAD"] +[2025-01-28 12:46:47.988126] (Utility.Process) process [22035] done ExitSuccess +[2025-01-28 12:46:47.990408] (Utility.Process) process [22036] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","refs/heads/master"] +[2025-01-28 12:46:47.996719] (Utility.Process) process [22036] done ExitSuccess +[2025-01-28 12:46:48.000582] (Utility.Process) process [22037] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","diff","--cached","--name-only","-z","--diff-filter=ACMRT","--","."] +[2025-01-28 12:46:48.007367] (Utility.Process) process [22037] done ExitSuccess +[2025-01-28 12:46:48.010028] (Utility.Process) process [22038] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","symbolic-ref","-q","HEAD"] +[2025-01-28 12:46:48.016108] (Utility.Process) process [22038] done ExitSuccess +[2025-01-28 12:46:48.018541] (Utility.Process) process [22039] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","refs/heads/master"] +[2025-01-28 12:46:48.025954] (Utility.Process) process [22039] done ExitSuccess +On branch master +nothing to commit, working tree clean +[2025-01-28 12:46:48.043086] (Utility.Process) process [22030] done ExitFailure 1 +ok +[2025-01-28 12:46:48.045582] (Utility.Process) process [22040] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","symbolic-ref","-q","HEAD"] +[2025-01-28 12:46:48.05211] (Utility.Process) process [22040] done ExitSuccess +[2025-01-28 12:46:48.054886] (Utility.Process) process [22041] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","refs/heads/master"] +[2025-01-28 12:46:48.062284] (Utility.Process) process [22041] done ExitSuccess +[2025-01-28 12:46:48.064679] (Utility.Process) process [22042] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--verify","-q","refs/heads/synced/master"] +[2025-01-28 12:46:48.071504] (Utility.Process) process [22042] done ExitSuccess +[2025-01-28 12:46:48.073977] (Utility.Process) process [22043] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","log","refs/heads/master..refs/heads/synced/master","--pretty=%H","-n1"] +[2025-01-28 12:46:48.080766] (Utility.Process) process [22043] done ExitSuccess +pull local1 +[2025-01-28 12:46:48.084197] (Utility.Process) process [22044] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","fetch","local1"] +[2025-01-28 12:46:48.170637] (Utility.Process) process [22080] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","git-annex"] +[2025-01-28 12:46:48.179566] (Utility.Process) process [22080] done ExitSuccess +[2025-01-28 12:46:48.183611] (Utility.Process) process [22081] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--hash","refs/heads/git-annex"] +[2025-01-28 12:46:48.192055] (Utility.Process) process [22081] done ExitSuccess +[2025-01-28 12:46:48.197482] (Utility.Process) process [22086] chat: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","cat-file","--batch"] +Full remote url: annex::7d7560cd-2e80-489d-af4a-ec23b9b9abb7?encryption=none&type=directory +[2025-01-28 12:46:48.215929] (Utility.Process) process [22087] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","git-annex"] +[2025-01-28 12:46:48.223041] (Utility.Process) process [22087] done ExitSuccess +[2025-01-28 12:46:48.225642] (Utility.Process) process [22088] read: git ["--version"] +[2025-01-28 12:46:48.231226] (Utility.Process) process [22088] done ExitSuccess +[2025-01-28 12:46:48.231795] (Annex.Perms) freezing content .git/annex/misctmp/gaprobe +[2025-01-28 12:46:48.231889] (Annex.Perms) thawing content .git/annex/misctmp/gaprobe +git-annex: No git repository found in this remote. +[2025-01-28 12:46:48.239358] (Utility.Process) process [22044] done ExitFailure 128 +ok +[2025-01-28 12:46:48.243384] (Utility.Process) process [22089] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","git-annex"] +[2025-01-28 12:46:48.250955] (Utility.Process) process [22089] done ExitSuccess +[2025-01-28 12:46:48.253625] (Utility.Process) process [22090] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--hash","refs/heads/git-annex"] +[2025-01-28 12:46:48.260937] (Utility.Process) process [22090] done ExitSuccess +[2025-01-28 12:46:48.264403] (Utility.Process) process [22091] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","symbolic-ref","-q","HEAD"] +[2025-01-28 12:46:48.270737] (Utility.Process) process [22091] done ExitSuccess +[2025-01-28 12:46:48.273298] (Utility.Process) process [22092] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","refs/heads/master"] +[2025-01-28 12:46:48.279777] (Utility.Process) process [22092] done ExitSuccess +[2025-01-28 12:46:48.282444] (Utility.Process) process [22093] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","branch","-f","synced/master","refs/heads/master"] +[2025-01-28 12:46:48.290967] (Utility.Process) process [22093] done ExitSuccess +[2025-01-28 12:46:48.293498] (Utility.Process) process [22094] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--verify","-q","refs/remotes/local1/synced/master"] +[2025-01-28 12:46:48.300336] (Utility.Process) process [22094] done ExitFailure 1 +push local1 +[2025-01-28 12:46:48.302852] (Utility.Process) process [22095] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","push","local1","master:synced/master","+git-annex:synced/git-annex"] +[2025-01-28 12:46:48.383262] (Utility.Process) process [22102] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","git-annex"] +[2025-01-28 12:46:48.389482] (Utility.Process) process [22102] done ExitSuccess +[2025-01-28 12:46:48.391771] (Utility.Process) process [22103] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--hash","refs/heads/git-annex"] +[2025-01-28 12:46:48.398109] (Utility.Process) process [22103] done ExitSuccess +[2025-01-28 12:46:48.402067] (Utility.Process) process [22104] chat: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","cat-file","--batch"] +Full remote url: annex::7d7560cd-2e80-489d-af4a-ec23b9b9abb7?encryption=none&type=directory +[2025-01-28 12:46:48.41247] (Utility.Process) process [22105] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","for-each-ref","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/","--format=%(objectname) %(refname)"] +[2025-01-28 12:46:48.419106] (Utility.Process) process [22105] done ExitSuccess +[2025-01-28 12:46:48.42299] (Utility.Process) process [22106] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--hash","refs/heads/git-annex"] +[2025-01-28 12:46:48.430151] (Utility.Process) process [22106] done ExitSuccess +[2025-01-28 12:46:48.434139] (Utility.Process) process [22107] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","--hash","refs/heads/master"] +[2025-01-28 12:46:48.440655] (Utility.Process) process [22107] done ExitSuccess +[2025-01-28 12:46:48.44324] (Utility.Process) process [22108] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","for-each-ref","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/","--format=%(objectname) %(refname)"] +[2025-01-28 12:46:48.449279] (Utility.Process) process [22108] done ExitSuccess +[2025-01-28 12:46:48.452854] (Utility.Process) process [22109] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","update-ref","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/refs/heads/synced/git-annex","b6817903fc3363e53ff863fcf79e90ab200130c3"] +[2025-01-28 12:46:48.460699] (Utility.Process) process [22109] done ExitSuccess +[2025-01-28 12:46:48.463036] (Utility.Process) process [22110] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","update-ref","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/refs/heads/synced/master","cee403c71ad8d180c149c26818b268b4fba67c3f"] +[2025-01-28 12:46:48.470252] (Utility.Process) process [22110] done ExitSuccess +[2025-01-28 12:46:48.473412] (Utility.Process) process [22111] feed: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","bundle","create","--quiet","/var/folders/2p/4z266zp97g9f0w5xxx4hkjz40000gn/T/GITBUNDLE22097-0","--stdin"] +[2025-01-28 12:46:48.494608] (Utility.Process) process [22111] done ExitSuccess +[2025-01-28 12:46:48.49778] (Utility.Process) process [22104] done ExitSuccess +[2025-01-28 12:46:48.505294] (Utility.Process) process [22116] call: cp ["-a","/var/folders/2p/4z266zp97g9f0w5xxx4hkjz40000gn/T/GITMANIFEST22097-3",".git/annex/objects/9q/z3/GITMANIFEST--7d7560cd-2e80-489d-af4a-ec23b9b9abb7.bak/GITMANIFEST--7d7560cd-2e80-489d-af4a-ec23b9b9abb7.bak"] +[2025-01-28 12:46:48.505403] (Utility.Process) process [22116] done ExitFailure (-9) +[2025-01-28 12:46:48.505502] (Annex.Perms) freezing content directory .git/annex/objects/9q/z3/GITMANIFEST--7d7560cd-2e80-489d-af4a-ec23b9b9abb7.bak +Push failed (Failed to upload manifest.) +[2025-01-28 12:46:48.507999] (Utility.Process) process [22117] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","for-each-ref","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/","--format=%(objectname) %(refname)"] +[2025-01-28 12:46:48.514991] (Utility.Process) process [22117] done ExitSuccess +[2025-01-28 12:46:48.518649] (Utility.Process) process [22118] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","update-ref","-d","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/refs/heads/synced/git-annex","b6817903fc3363e53ff863fcf79e90ab200130c3"] +[2025-01-28 12:46:48.525217] (Utility.Process) process [22118] done ExitSuccess +[2025-01-28 12:46:48.528742] (Utility.Process) process [22119] call: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","update-ref","-d","refs/namespaces/git-remote-annex/7d7560cd-2e80-489d-af4a-ec23b9b9abb7/refs/heads/synced/master","cee403c71ad8d180c149c26818b268b4fba67c3f"] +[2025-01-28 12:46:48.535612] (Utility.Process) process [22119] done ExitSuccess +warning: helper reported unexpected status of push +warning: helper reported unexpected status of push +Everything up-to-date +[2025-01-28 12:46:48.5386] (Utility.Process) process [22120] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","show-ref","git-annex"] +[2025-01-28 12:46:48.545982] (Utility.Process) process [22120] done ExitSuccess +[2025-01-28 12:46:48.549657] (Utility.Process) process [22121] read: git ["--version"] +[2025-01-28 12:46:48.555248] (Utility.Process) process [22121] done ExitSuccess +[2025-01-28 12:46:48.555667] (Annex.Perms) freezing content .git/annex/misctmp/gaprobe +[2025-01-28 12:46:48.555747] (Annex.Perms) thawing content .git/annex/misctmp/gaprobe +[2025-01-28 12:46:48.558896] (Utility.Process) process [22122] chat: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","cat-file","--batch"] +[2025-01-28 12:46:48.574158] (Utility.Process) process [22095] done ExitSuccess +[2025-01-28 12:46:48.576864] (Utility.Process) process [22123] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","push","local1","git-annex"] +[2025-01-28 12:46:48.808953] (Utility.Process) process [22123] done ExitSuccess +[2025-01-28 12:46:48.813005] (Utility.Process) process [22148] read: git ["--git-dir=.git","--work-tree=.","--literal-pathspecs","push","local1","master"] +[2025-01-28 12:46:49.062622] (Utility.Process) process [22148] done ExitSuccess +ok +[2025-01-28 12:46:49.063559] (Utility.Process) process [22029] done ExitSuccess +% + + +% cat .git/config +[core] + repositoryformatversion = 0 + filemode = true + bare = false + logallrefupdates = true + ignorecase = true + precomposeunicode = true +[annex] + uuid = bb331ff4-2e85-4657-869a-202d269d4b3c + version = 10 +[filter "annex"] + smudge = git-annex smudge -- %f + clean = git-annex smudge --clean -- %f + process = git-annex filter-process +[remote "local1"] + annex-directory = /tmp/git-annex-testing/specialdirectoryremote + annex-uuid = 7d7560cd-2e80-489d-af4a-ec23b9b9abb7 + skipFetchAll = true + url = annex:: + fetch = +refs/heads/*:refs/remotes/foo/* +% +"""]] + +### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders) +Yup! + diff --git a/doc/bugs/git_annex_checkpresentkey_removes_git_credentials/comment_3_a53bfbd63b3ec5834286167a61d5c4ba._comment b/doc/bugs/git_annex_checkpresentkey_removes_git_credentials/comment_3_a53bfbd63b3ec5834286167a61d5c4ba._comment new file mode 100644 index 0000000000..ec4fbe5cf7 --- /dev/null +++ b/doc/bugs/git_annex_checkpresentkey_removes_git_credentials/comment_3_a53bfbd63b3ec5834286167a61d5c4ba._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="matrss" + avatar="http://cdn.libravatar.org/avatar/cd1c0b3be1af288012e49197918395f0" + subject="comment 3" + date="2025-01-27T15:08:57Z" + content=""" +I can still reproduce this issue with 10.20250115, but in my testing it seems like it only happens against a forgejo-aneksajo instance on localhost without TLS, not against a different remote instance. This setup required `git config annex.security.allowed-ip-addresses 127.0.0.1`, maybe it has something to do with that or TLS... +"""]] diff --git a/doc/bugs/git_annex_checkpresentkey_removes_git_credentials/comment_4_58ddd2578f115af22e995bd09c2bcea2._comment b/doc/bugs/git_annex_checkpresentkey_removes_git_credentials/comment_4_58ddd2578f115af22e995bd09c2bcea2._comment new file mode 100644 index 0000000000..bd64c6c224 --- /dev/null +++ b/doc/bugs/git_annex_checkpresentkey_removes_git_credentials/comment_4_58ddd2578f115af22e995bd09c2bcea2._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="matrss" + avatar="http://cdn.libravatar.org/avatar/cd1c0b3be1af288012e49197918395f0" + subject="comment 4" + date="2025-01-27T15:14:44Z" + content=""" +It definitely takes a different code path somehow, as I don't see the `Utility.Url` debug messages when the remote is not on localhost. +"""]] diff --git a/doc/bugs/rsyncurl_without___34____58____34___creates_local_folder_as_remote.mdwn b/doc/bugs/rsyncurl_without___34____58____34___creates_local_folder_as_remote.mdwn new file mode 100644 index 0000000000..dfd518403d --- /dev/null +++ b/doc/bugs/rsyncurl_without___34____58____34___creates_local_folder_as_remote.mdwn @@ -0,0 +1,69 @@ +### Please describe the problem. + +When setting up an (SSH) rsync remote, and _not_ adding the `:` at the end of the hostname, it will create a local folder instead of copying to remote. + +``` +[joe@laptop]$ git annex initremote myremote type=rsync rsyncurl=ssh.example.com encryption=hybrid keyid=00001111222233334444 +[joe@laptop]$ git annex copy . --to myremote +copy metal-arm64.raw (to rpi50...) +ok +copy nixos-gnome-24.11.712512.3f0a8ac25fb6-x86_64-linux.iso (to myremote...) +ok +(recording state in git...) +[joe@laptop]$ ls -l +insgesamt 246792 +lrwxrwxrwx. 1 joe joe 204 20. Jan 21:01 metal-arm64.raw -> .git/annex/objects/mG/21/SHA256E-s1306525696--21308f635774faf611ba35c9b04d638aeb7afb1b1c1db949ae65ff81cdafe8b7.raw/SHA256E-s1306525696--21308f635774faf611ba35c9b04d638aeb7afb1b1c1db949ae65ff81cdafe8b7.raw +lrwxrwxrwx. 1 joe joe 204 20. Jan 21:01 nixos-gnome-24.11.712512.3f0a8ac25fb6-x86_64-linux.iso -> .git/annex/objects/fX/g9/SHA256E-s2550136832--da2fe173a279d273bf5a999eafdb618db0642f4a3df95fd94a6585c45082a7f0.iso/SHA256E-s2550136832--da2fe173a279d273bf5a999eafdb618db0642f4a3df95fd94a6585c45082a7f0.iso +drwxr-xr-x. 1 joe joe 12 26. Jan 11:32 ssh.example.com # <---- for me, that was not expected behaviour +``` + +It might be a feature I don't understand, but because I couldn't find documentation about it, I am leaning towards non-intended behaviour. My assumption would be, that a rsync operation to a local directory is already implemented with the [directory special remote](https://git-annex.branchable.com/special_remotes/directory/). + +### What steps will reproduce the problem? + +Have a remote rsync server, where you don't need to specify the base directory. In my case [this is done with NixOS and this configuration which uses `rrsync`](https://wiki.nixos.org/wiki/Rsync). + +The following configures the rsync remote, and later pushed files to it (so far expected behaviour): + +``` +git annex initremote myremote type=rsync rsyncurl=ssh.example.com: encryption=hybrid keyid=00001111222233334444 +git annex copy . --to myremote +``` + +This however, doesn't copy to the correct remote, but creates a local folder named `ssh.example.com` in my annexed directory instead (note the missing `:` after the hostname): + +``` +git annex initremote myremote type=rsync rsyncurl=ssh.example.com encryption=hybrid keyid=00001111222233334444 +git annex copy . --to myremote # will copy successfully, BUT +ls -l # shows the folder `ssh.example.com` in my directory with the files in it, the rsync remote is empty +``` + +### What version of git-annex are you using? On what operating system? + +* Fedora 41 + +``` +git-annex version: 10.20240701 +build flags: Assistant Webapp Pairing Inotify DBus DesktopNotify TorrentParser MagicMime Benchmark Feeds Testsuite S3 WebDAV +dependency versions: aws-0.24.1 bloomfilter-2.0.1.2 crypton-0.34 DAV-1.3.4 feed-1.3.2.1 ghc-9.6.6 http-client-0.7.17 persistent-sqlite-2.13.3.0 torrent-10000.1.3 uuid-1.3.15 yesod-1.6.2.1 +key/value backends: SHA256E SHA256 SHA512E SHA512 SHA224E SHA224 SHA384E SHA384 SHA3_256E SHA3_256 SHA3_512E SHA3_512 SHA3_224E SHA3_224 SHA3_384E SHA3_384 SKEIN256E SKEIN256 SKEIN512E SKEIN512 BLAKE2B256E BLAKE2B256 BLAKE2B512E BLAKE2B512 BLAKE2B160E BLAKE2B160 BLAKE2B224E BLAKE2B224 BLAKE2B384E BLAKE2B384 BLAKE2BP512E BLAKE2BP512 BLAKE2S256E BLAKE2S256 BLAKE2S160E BLAKE2S160 BLAKE2S224E BLAKE2S224 BLAKE2SP256E BLAKE2SP256 BLAKE2SP224E BLAKE2SP224 SHA1E SHA1 MD5E MD5 WORM URL GITBUNDLE GITMANIFEST VURL X* +remote types: git gcrypt p2p S3 bup directory rsync web bittorrent webdav adb tahoe glacier ddar git-lfs httpalso borg rclone hook external +operating system: linux x86_64 +supported repository versions: 8 9 10 +upgrade supported from repository versions: 0 1 2 3 4 5 6 7 8 9 10 +local repository version: 10 +``` + +### Please provide any additional information below. + +[[!format sh """ +# If you can, paste a complete transcript of the problem occurring here. +# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log + + +# End of transcript or log. +"""]] + +### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders) + +I am just now starting to _really_ use git-annex, after following it's development and every blogpost you wrote about it for almost a decade now. Thank you for a tool desperately needed! diff --git a/doc/bugs/rsyncurl_without___34____58____34___creates_local_folder_as_remote/comment_1_b218e908bd2f897415e6d34137f8536b._comment b/doc/bugs/rsyncurl_without___34____58____34___creates_local_folder_as_remote/comment_1_b218e908bd2f897415e6d34137f8536b._comment new file mode 100644 index 0000000000..b38b06793b --- /dev/null +++ b/doc/bugs/rsyncurl_without___34____58____34___creates_local_folder_as_remote/comment_1_b218e908bd2f897415e6d34137f8536b._comment @@ -0,0 +1,12 @@ +[[!comment format=mdwn + username="matrss" + avatar="http://cdn.libravatar.org/avatar/cd1c0b3be1af288012e49197918395f0" + subject="comment 1" + date="2025-01-27T11:28:43Z" + content=""" +I'd say this is intended behavior: I assume that the rsyncurl option is more less passed verbatim to rsync, and rsync can act on both local and remote paths. There is the possibility to use `rsync://` URLs, remote paths via SSH where the host and path are separated by a colon, and local paths. + +The rsync special remote with local paths behaves a bit differently than the directory special remote, namely the rsyncurl is remembered (e.g. for autoenable) while the directory special remote does not remember the directory. There can be use-cases for both. + +Besides, most of the time I think one would want to specify a remote directory with rsync, in which case the colon is necessary anyway. +"""]] diff --git a/doc/design/assistant/polls/prioritizing_special_remotes.mdwn b/doc/design/assistant/polls/prioritizing_special_remotes.mdwn index 1307c892cd..2c6d62e9c2 100644 --- a/doc/design/assistant/polls/prioritizing_special_remotes.mdwn +++ b/doc/design/assistant/polls/prioritizing_special_remotes.mdwn @@ -6,7 +6,7 @@ locally paired systems, and remote servers with rsync. Help me prioritize my work: What special remote would you most like to use with the git-annex assistant? -[[!poll open=yes 18 "Amazon S3 (done)" 13 "Amazon Glacier (done)" 10 "Box.com (done)" 79 "My phone (or MP3 player)" 29 "Tahoe-LAFS" 19 "OpenStack SWIFT" 37 "Google Drive"]] +[[!poll open=yes 18 "Amazon S3 (done)" 13 "Amazon Glacier (done)" 10 "Box.com (done)" 81 "My phone (or MP3 player)" 29 "Tahoe-LAFS" 19 "OpenStack SWIFT" 37 "Google Drive"]] This poll is ordered with the options I consider easiest to build listed first. Mostly because git-annex already supports them and they diff --git a/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__.mdwn b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__.mdwn new file mode 100644 index 0000000000..fee3c11b31 --- /dev/null +++ b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__.mdwn @@ -0,0 +1 @@ +I run a server and have a 2.5TB repo on a 4TB drive. Right now I have a bare repo for outside connections on it, but thought about a non-bare repo beside this on the same drive for local use. Does git-annex realize the repos are on the same btrfs-volume and uses ```cp --reflink``` while syncing between them? diff --git a/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_1_464adfa71d322249dfed4ba65c24995d._comment b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_1_464adfa71d322249dfed4ba65c24995d._comment new file mode 100644 index 0000000000..bd8ae47014 --- /dev/null +++ b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_1_464adfa71d322249dfed4ba65c24995d._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="Atemu" + avatar="http://cdn.libravatar.org/avatar/6ac9c136a74bb8760c66f422d3d6dc32" + subject="comment 1" + date="2025-01-26T02:36:51Z" + content=""" +It will not realise this. + +Why do you have separate repos for this though? You can absolutely just use a non-plain git repo for synchronisation purposes too. +"""]] diff --git a/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_2_e4cd3108130efbfa796e1ff5e5f55116._comment b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_2_e4cd3108130efbfa796e1ff5e5f55116._comment new file mode 100644 index 0000000000..7080606ce5 --- /dev/null +++ b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_2_e4cd3108130efbfa796e1ff5e5f55116._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="jnkl" + avatar="http://cdn.libravatar.org/avatar/2ab576f3bf2e0d96b1ee935bb7f33dbe" + subject="comment 2" + date="2025-01-26T13:09:04Z" + content=""" +Sorry, I am new to git. I thought pushes are only allowed to bare repositories. Am I wrong? +"""]] diff --git a/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_3_f2069c83af180c7026700a102a528827._comment b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_3_f2069c83af180c7026700a102a528827._comment new file mode 100644 index 0000000000..e1a73cf187 --- /dev/null +++ b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_3_f2069c83af180c7026700a102a528827._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="Atemu" + avatar="http://cdn.libravatar.org/avatar/6ac9c136a74bb8760c66f422d3d6dc32" + subject="comment 3" + date="2025-01-26T13:30:10Z" + content=""" +git-annex synchronises branch state via the `synced/branchnamehere` branches. The actual checked out branch in the worktree will only be updated when you run a `merge` or `sync` in the worktree. +"""]] diff --git a/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_4_48d98de3582217dcbcdc6b6968c5152d._comment b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_4_48d98de3582217dcbcdc6b6968c5152d._comment new file mode 100644 index 0000000000..8f5d03e544 --- /dev/null +++ b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_4_48d98de3582217dcbcdc6b6968c5152d._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="jnkl" + avatar="http://cdn.libravatar.org/avatar/2ab576f3bf2e0d96b1ee935bb7f33dbe" + subject="comment 4" + date="2025-01-28T21:20:17Z" + content=""" +Thank you. So bare repositories are only needed when I want to save disk space with git annex? +"""]] diff --git a/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_5_051d14d4b7439d10f9879aff505a923c._comment b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_5_051d14d4b7439d10f9879aff505a923c._comment new file mode 100644 index 0000000000..65d97fce89 --- /dev/null +++ b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_5_051d14d4b7439d10f9879aff505a923c._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="Atemu" + avatar="http://cdn.libravatar.org/avatar/6ac9c136a74bb8760c66f422d3d6dc32" + subject="comment 5" + date="2025-01-28T21:57:42Z" + content=""" +Indeed. However the space savings would likely be marginal in a typical git-annex repo. +"""]] diff --git a/doc/forum/How_to_figure_out_why_files_aren__39__t_being_dropped__63__/comment_2_ba87cf91217ba01415ff55d33550a75b._comment b/doc/forum/How_to_figure_out_why_files_aren__39__t_being_dropped__63__/comment_2_ba87cf91217ba01415ff55d33550a75b._comment new file mode 100644 index 0000000000..603dcfdae8 --- /dev/null +++ b/doc/forum/How_to_figure_out_why_files_aren__39__t_being_dropped__63__/comment_2_ba87cf91217ba01415ff55d33550a75b._comment @@ -0,0 +1,26 @@ +[[!comment format=mdwn + username="Atemu" + avatar="http://cdn.libravatar.org/avatar/6ac9c136a74bb8760c66f422d3d6dc32" + subject="comment 2" + date="2025-01-26T02:54:18Z" + content=""" +My issue apparently had to do with numcopies? I first passed `--numcopies 2` because I was curious but it didn't change anything. Then I passed `--numcopies 1` and it immediately dropped all the files as I'd have expected it to at `numcopies=3`. Running another sync without `--numcopies` didn't attempt to pull in the dropped files either. + +This smells like a bug? If numcopies was actually violated, it should attempt to correct that again, right? (All files were available from a connected repo.) + +Here are the numcopies stats from `git annex info .`: + +``` +numcopies stats: + numcopies +1: 1213 + numcopies +0: 25310 +``` + +Some more background: I have a bunch of drives that are offline that I have set to be trusted. One repo on my NAS is online at all times and semitrusted. + +I have two offline groups: `cold` and `lukewarm`. All drives in those groups are trusted. + +It's weird that it didn't work with 2 but did work with 1. This leads me to believe it could have been due to the one repo being online while the others are offline and trusted; acting more like mincopies. Was behaviour changed in this regard recently? + +I'd still like to know how to debug wanted expressions too though. +"""]] diff --git a/doc/forum/Keeping_the_overview_-_git_annex_list_--compact__63__.mdwn b/doc/forum/Keeping_the_overview_-_git_annex_list_--compact__63__.mdwn new file mode 100644 index 0000000000..31d1bd90f7 --- /dev/null +++ b/doc/forum/Keeping_the_overview_-_git_annex_list_--compact__63__.mdwn @@ -0,0 +1,31 @@ +Is there a way to obtain/keep the overview over a git annex repository with many directories and files? For example to answer the following question in a compact way: which subdirectories of the current directory are complete locally? + +The needed information is provided by both `git annex list` and `git annex info`, but the output of both command is very verbose and difficult to parse visually. + +For example part of the output of `git annex list` could be: + +``` +XXX__ foo/bar/a +XXX__ foo/bar/b +XXX__ foo/bar/c +XXX__ foo/hey/d +XXX__ foo/hey/e +XXX__ foo/hey/f +``` + +Assuming that the `foo` directory contains no further files this could be compacted to + +``` +XXX__ foo/bar/ +XXX__ foo/hey/ +``` + +or even + +``` +XXX__ foo/ +``` + +Of course the above procedure would only compact directories if all files have the same presence status. But I guess that this will be true in many cases. + +I’m thinking about implementing this as a filter to the output of `git annex list`, but wanted to check whether similar ideas haven’t been considered here before. (I could not find anything.) diff --git a/doc/forum/Reasonable_annex.bloomcapacity__63__.mdwn b/doc/forum/Reasonable_annex.bloomcapacity__63__.mdwn new file mode 100644 index 0000000000..b5cafce72e --- /dev/null +++ b/doc/forum/Reasonable_annex.bloomcapacity__63__.mdwn @@ -0,0 +1,15 @@ +What is a reasonable value for ```annex.bloomcapacity``` in this situation and in what unit? + + local annex keys: 670671 + local annex size: 2.62 terabytes + annexed files in working tree: 1410199 + size of annexed files in working tree: 3.52 terabytes + combined annex size of all repositories: 2.63 terabytes + annex sizes of repositories: + 2.62 TB: b2e77041-584e-4699-947d-ef5004273901 -- pudong [here] + 7.39 GB: 42a53a13-7ad6-43a5-95ef-813d4f8c1a6f -- [batam_payload] + backend usage: + SHA256E: 1410199 + bloom filter size: 32 mebibytes (appears too small for this repository; adjust annex.bloomcapacity) + +I don't really understand what happens when the bloom filter is too small. diff --git a/doc/forum/Reasonable_annex.bloomcapacity__63__/comment_1_0361164f67f44520f3af5ba88adc3868._comment b/doc/forum/Reasonable_annex.bloomcapacity__63__/comment_1_0361164f67f44520f3af5ba88adc3868._comment new file mode 100644 index 0000000000..2a63d58ddd --- /dev/null +++ b/doc/forum/Reasonable_annex.bloomcapacity__63__/comment_1_0361164f67f44520f3af5ba88adc3868._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2025-01-29T15:54:19Z" + content=""" +What will happen with too small a bloom filter is `git-annex unused` may +think that some keys are used which are really not. And +`git-annex sync --content` may operate on some keys that are not in the +work tree. + +The `git-annex info` command displays how much memory the configured bloom +filters use, which is why it's reporting 32 membibytes. But the +annex.bloomcapacity setting is the number of expected files in the work +tree, by default 500000. + +It would probably make sense for you to set it to 2000000 or so unless +your system has an unusually small amount of RAM. +"""]] diff --git a/doc/forum/b2_rclone_initremote_failed__58___empty_folders/comment_1_bfceb1a2ce7d9c70b1c79252a8e12822._comment b/doc/forum/b2_rclone_initremote_failed__58___empty_folders/comment_1_bfceb1a2ce7d9c70b1c79252a8e12822._comment new file mode 100644 index 0000000000..751c577e29 --- /dev/null +++ b/doc/forum/b2_rclone_initremote_failed__58___empty_folders/comment_1_bfceb1a2ce7d9c70b1c79252a8e12822._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="dmcardle" + avatar="http://cdn.libravatar.org/avatar/b79468a0d03ec3ec7acbae547c4fa994" + subject="comment 1" + date="2025-01-29T14:44:37Z" + content=""" +Hi, author of rclone's \"gitannex\" command here. Sorry you're running into trouble with it! + +Based on the text, that error is definitely coming from [gitannex.go](https://github.com/rclone/rclone/blob/6494ac037fdd7ada2052ae9a8e05d230e7e686b2/cmd/gitannex/gitannex.go#L276). + +I believe that my intent was to detect that the following mkdir would fail, and offer up a more specific error message rather than letting it fail. + +I don't know anything about Backblaze B2, unfortunately. I suppose we could work around the issue by creating an empty file underneath the place we want the empty directory. Sounds plausible, right? + +Would you mind trying to make an empty directory on your B2 remote to verify it fails? Something like `rclone mkdir myremote:newdir`. + +And also try touching a file in a new directory to verify it's possible in one go? Something like `rclone touch --recursive myremote:newdir/newfile.txt`. +"""]] diff --git a/doc/forum/reuploads_existing_files_to_bare_repo.mdwn b/doc/forum/reuploads_existing_files_to_bare_repo.mdwn new file mode 100644 index 0000000000..bee9eb0d11 --- /dev/null +++ b/doc/forum/reuploads_existing_files_to_bare_repo.mdwn @@ -0,0 +1,5 @@ +I created a bare repo on a small always on server and synced it with my desktop. + +Now, when I sync it with my laptop, annex on the laptop reuploads all files, which were already uploaded by the desktop. I see that because annex on the laptop fills the upstream even though the bare repo on the server does not take more harddisk space while this happens. + +Is this by design and why? diff --git a/doc/forum/reuploads_existing_files_to_bare_repo/comment_1_427da1bb31bbbcdb88dce5d253e976cc._comment b/doc/forum/reuploads_existing_files_to_bare_repo/comment_1_427da1bb31bbbcdb88dce5d253e976cc._comment new file mode 100644 index 0000000000..876a18446e --- /dev/null +++ b/doc/forum/reuploads_existing_files_to_bare_repo/comment_1_427da1bb31bbbcdb88dce5d253e976cc._comment @@ -0,0 +1,24 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2025-01-22T20:43:32Z" + content=""" +If the laptop has not pulled from the server since those files were sent to +it, it does not know the server contains the files yet. So it will try to +send them again. Normally this won't result in the same content being +actually sent again, instead for each file it will check if the file is in +the server yet, and when it sees it is, it won't send it again. + +My first guess is that just the network overhead of doing those checks is +what "fills the upstream". + +It is possible that it's actually re-uploading files that the server +already has, without checking it first, which will result in the server +accepting the upload and then throwing it away, since it already has the content. +This can happen eg, if the same file is being sent into a repository from +two other repositories at the same time. But I don't know of any common +situations where it happens. + +So, if you're sure it's doing that, please provide details about what exact +git-annex commands you're running that are causing it to do that. +"""]] diff --git a/doc/forum/reuploads_existing_files_to_bare_repo/comment_2_04946c3d6240ab5a4e0559edab301c1a._comment b/doc/forum/reuploads_existing_files_to_bare_repo/comment_2_04946c3d6240ab5a4e0559edab301c1a._comment new file mode 100644 index 0000000000..3dc0418920 --- /dev/null +++ b/doc/forum/reuploads_existing_files_to_bare_repo/comment_2_04946c3d6240ab5a4e0559edab301c1a._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="jnkl" + avatar="http://cdn.libravatar.org/avatar/2ab576f3bf2e0d96b1ee935bb7f33dbe" + subject="comment 2" + date="2025-01-25T11:49:29Z" + content=""" +I don't think it was the overhead (stopped it at uploaded 30G for a 180G repo). I am in the process of recreating the repo, so I can't give you further information for now. Will come back to you if it happens again. Thanks for your answer and your awesome work! +"""]] diff --git a/doc/git-annex-dead/comment_1_704469f0deb075d0b3c70c73708cd456._comment b/doc/git-annex-dead/comment_1_704469f0deb075d0b3c70c73708cd456._comment new file mode 100644 index 0000000000..11cd23cf15 --- /dev/null +++ b/doc/git-annex-dead/comment_1_704469f0deb075d0b3c70c73708cd456._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="yarikoptic" + avatar="http://cdn.libravatar.org/avatar/f11e9c84cb18d26a1748c33b48c924b4" + subject="comment 1" + date="2025-01-23T15:53:39Z" + content=""" +is there `git annex undead` to easily mitigate users doing what they should have not done? ;-) + +Would it be sufficient to just remove the corresponding `X` line from `trust.log`? +"""]] diff --git a/doc/git-annex-dead/comment_2_4da905b6b8c0c0ba31f4379bf6d940e0._comment b/doc/git-annex-dead/comment_2_4da905b6b8c0c0ba31f4379bf6d940e0._comment new file mode 100644 index 0000000000..9e736aefaf --- /dev/null +++ b/doc/git-annex-dead/comment_2_4da905b6b8c0c0ba31f4379bf6d940e0._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="yarikoptic" + avatar="http://cdn.libravatar.org/avatar/f11e9c84cb18d26a1748c33b48c924b4" + subject="comment 2" + date="2025-01-23T21:33:25Z" + content=""" +d'oh -- it is `git annex semitrust here` to return the \"trust\" into a dead beast ;) +"""]] diff --git a/doc/git-annex-whereused/comment_4_2270f72a453d8a75a2e050c82561e4ae._comment b/doc/git-annex-whereused/comment_4_2270f72a453d8a75a2e050c82561e4ae._comment new file mode 100644 index 0000000000..a469b42363 --- /dev/null +++ b/doc/git-annex-whereused/comment_4_2270f72a453d8a75a2e050c82561e4ae._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="beryllium@5bc3c32eb8156390f96e363e4ba38976567425ec" + nickname="beryllium" + avatar="http://cdn.libravatar.org/avatar/62b67d68e918b381e7e9dd6a96c16137" + subject="comment 4" + date="2025-01-24T08:04:27Z" + content=""" +I don't know if this is expected behaviour, but for some files I imported from an importtree, when I use git-annex whereused --key with the correct key, nothing is shown unless I also add --historical + +And then I am shown the importtree branch information. It doesn't seem to make sense to me. The file is definitely present, and git-annex whereis confirms this, as does git-annex lock/unlock + +Willing to add more context if this is a little too vague + +Shaddy Baddah (beryllium at shaddybaddah dot name) + +"""]] diff --git a/doc/special_remotes/git/comment_3_974bf32abc3d093d6ebcda4838a79553._comment b/doc/special_remotes/git/comment_3_974bf32abc3d093d6ebcda4838a79553._comment new file mode 100644 index 0000000000..5798ac595b --- /dev/null +++ b/doc/special_remotes/git/comment_3_974bf32abc3d093d6ebcda4838a79553._comment @@ -0,0 +1,44 @@ +[[!comment format=mdwn + username="beryllium@5bc3c32eb8156390f96e363e4ba38976567425ec" + nickname="beryllium" + avatar="http://cdn.libravatar.org/avatar/62b67d68e918b381e7e9dd6a96c16137" + subject="Simple config amendment for Apache served repositories" + date="2025-01-28T08:34:40Z" + content=""" +If you follow the [git-http-backend][id] documentation for serving repositories via Apache, you'll read this section: + + +

To serve gitweb at the same url, use a ScriptAliasMatch to only +those URLs that git http-backend can handle, and forward the +rest to gitweb:

+ +
+
+
ScriptAliasMatch \
+	\"(?x)^/git/(.*/(HEAD | \
+			info/refs | \
+			objects/(info/[^/]+ | \
+				 [0-9a-f]{2}/[0-9a-f]{38} | \
+				 pack/pack-[0-9a-f]{40}\.(pack|idx)) | \
+			git-(upload|receive)-pack))$\" \
+	/usr/libexec/git-core/git-http-backend/$1
+
+ScriptAlias /git/ /var/www/cgi-bin/gitweb.cgi/
+
+
+
+ +If you add the following AliasMatch between the two ScriptAlias directives, you can get Apache to serve the (...).git/config file to the http client, in this case git-annex. + +
+AliasMatch \"(?x)^/git/(.*/config)$\" /var/www/git/$1
+
+ +This allows the annexes to use the autoenable=true to pin the centralisation afforded by the git only repository. Keep a \"source of truth\" so to speak (acknowledging that this is antithetical to what git-annex aims to do). + +As an aside, the tip to generate a uuid didn't seem to work for me. But I suspect I missed the point somewhat. + +Regardless, if you are able to alter the configuration of your \"centralised\" git repository, this might be of assistance. + +[id]: https://git-scm.com/docs/git-http-backend \"git-http-backend\" +"""]] diff --git a/doc/todo/RawFilePath_conversion.mdwn b/doc/todo/RawFilePath_conversion.mdwn index b1e1d3e9cd..6268d93164 100644 --- a/doc/todo/RawFilePath_conversion.mdwn +++ b/doc/todo/RawFilePath_conversion.mdwn @@ -8,17 +8,24 @@ Some commands like `git-annex find` use RawFilePath end-to-end. But this conversion is not yet complete. This is a todo to keep track of the status. -* The Abstract FilePath proposal (AFPP) has been implemented, and so a number of - libraries like unix and directory now have versions that operate on - OSPath. That could be used in git-annex eg for things like - getDirectoryContents, when built against those versions. - (But OSPath uses ShortByteString, while RawFilePath is ByteString, so - conversion still entails a copy.) -* withFile remains to be converted, and is used in several important code - paths, including Annex.Journal and Annex.Link. - There is a RawFilePath version in file-io library, but that is - not currently a git-annex dependency. (withFile is in base, and base is - unlikely to convert to AFPP soon) +* unix has modules that operate on RawFilePath but no OSPath versions yet. + See https://github.com/haskell/unix/issues/240 +* filepath-1.4.100 implements support for OSPath. It is bundled with + ghc-9.6.1 and above. Will need to switch from filepath-bytestring to + this, and to avoid a lot of ifdefs, probably only after git-annex no + longers supports building with older ghc versions. This will entail + replacing all the RawFilePath with OsPath, which should be pretty + mechanical, with only some wrapper functions in Utility.FileIO and + Utility.RawFilePath needing to be changed. +* Utility.FileIO is used for most withFile and openFile, but not yet for + readFile, writeFile, and appendFile on FilePaths. + Note that the FilePath versions do newline translation on windows, + which has to be handled when converting to the Utility.FileIO ones. +* System.Directory.OsPath is available with OsPath build flag, but + not yet used, and would eliminate a lot of fromRawFilePaths. + Make Utility.SystemDirectory import it when built with OsPath, + and the remaining 6 hours or work will explain itself.. + This has been started in the `ospath` branch. [[!tag confirmed]] diff --git a/doc/todo/compute_special_remote/comment_10_304b925c5c54b1fd980446920780be00._comment b/doc/todo/compute_special_remote/comment_10_304b925c5c54b1fd980446920780be00._comment new file mode 100644 index 0000000000..0a870654f6 --- /dev/null +++ b/doc/todo/compute_special_remote/comment_10_304b925c5c54b1fd980446920780be00._comment @@ -0,0 +1,70 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 10""" + date="2025-01-28T14:06:41Z" + content=""" +Using metadata to store the inputs of computations like I did in my example +above seems that it would allow the metadata to be changed later, which +would change the output when a key gets recomputed. That feels surprising, +because metadata could be changed for any reason, without the intention +of affecting a compute special remote. + +It might be possible for git-annex to pin down the current state of +metadata (or the whole git-annex branch) and provide the same input to the +computation when it's run again. (Unless `git-annex forget` has caused +that old branch state to be lost..) But it can't fully isolate the program +from all unpinned inputs without using some form of containerization, +which feels out of scope for git-annex. + +Instead of using metadata, the input values could be stored in the +per-special-remote state of the generated key. Or the input values could be +encoded in the key itself, but then two computations that generate the same +output would have two different keys, rather than hashing to the same key. + +Using a key with a regular hash backend also lets the user find out if the +computation turns out to not be reproducible later for whatever reason; +getting the file from the compute special remote will fail at hash +verification time. Something like a VURL key could still alternatively be +used in cases where reproducibility is not important. + +To add a computed file, the interface would look close to the same, +but now the --value options are setting fields in the compute special +remote's state: + + git-annex addcomputed foo --to ffmpeg-cut \ + --input source=input.mov \ + --value starttime=15:00 \ + --value endtime=30:00 + +The values could be provided to the "git-annex-compute-" program with +environment variables. + +For `--input source=foo`, it could look up the git-annex key (or git sha1) +of that file, and store that in the state. So it would provide the compute +program with the same data every time. But it could *also* store the +filename. And that allows for a command like this: + + git-annex recompute foo --from ffmpeg-cut + +Which, when the input.mov file has been changed, would re-run the +computation with the new content of the file, and stage a new version of +the computed file. It could even be used to recompute every file in a tree: + + git-annex recompute . --from ffmpeg-cut + +Also, that command could let input values be adjusted later: + + git-annex recompute foo --from ffmpeg-cut --value starttime=14:50 + git commit -m 'include the introduction of the speaker in the clip' + +It would also be good to have a command that examines a computed key +and displays the values and inputs. That could be `git-annex whereis` +or perhaps a dedicated command with more structured output: + + git-annex examinecompute foo --from ffmpeg-cut + source=input.mov (annex key SHA256--xxxxxxxxx) + starttime=15:00 + endtime=30:00 + +This all feels like it might allow for some useful workflows... +"""]] diff --git a/doc/todo/compute_special_remote/comment_11_5addc5ef9399ffedc23190c9d4e566ce._comment b/doc/todo/compute_special_remote/comment_11_5addc5ef9399ffedc23190c9d4e566ce._comment new file mode 100644 index 0000000000..454c11de0b --- /dev/null +++ b/doc/todo/compute_special_remote/comment_11_5addc5ef9399ffedc23190c9d4e566ce._comment @@ -0,0 +1,24 @@ +[[!comment format=mdwn + username="joey" + subject="""Re: worktree provisioning""" + date="2025-01-28T14:08:29Z" + content=""" +@m.risse in your example the "data.nc" file gets new content when +retrieved from the special remote and the source file has changed. + +But if you already have data.nc file present in a repository, it +does not get updated immediately when you update the source +"data.grib" file. + +So, a drop and re-get of a file changes the version of the file you have +available. For that matter, if the old version has been stored on other +remotes, a get may retrieve either an old or a new version. +That is not intuitive and it makes me wonder if using a +special remote is really a good fit for what you're wanting to do. + +In your "cdo" example, it's not clear to me if the new version of the +software generates an identical file to the old, or if it has a bug fix +that causes it to generate a significantly different output. If the two +outputs are significantly different then treating them as the same +git-annex key seems questionable to me. +"""]] diff --git a/doc/todo/compute_special_remote/comment_12_ddc985546fee804733c4ec485253e98f._comment b/doc/todo/compute_special_remote/comment_12_ddc985546fee804733c4ec485253e98f._comment new file mode 100644 index 0000000000..c05e779876 --- /dev/null +++ b/doc/todo/compute_special_remote/comment_12_ddc985546fee804733c4ec485253e98f._comment @@ -0,0 +1,29 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 12""" + date="2025-01-28T15:39:44Z" + content=""" +My design so far does not fully support +"Request one key, receive many". + +My `git-annex addcomputed` command doesn't handle the case where a +computation generates multiple output files. While the `git-annex-compute-` +command's interface could let it return several computed files, addcomputed +would only adds one file to the name that the user specifies. What is it +supposed to do if the computation generates more than one? Maybe it needs a +way to let a whole directory be populated with the files generated by a +computation. Or a way to specify multiple files to add. + +And here's another problem: +Suppose I have one very expensive computation that generates files foo +and bar. And a second, less expensive computation, that also generates foo +(same content) as well as generating baz. Both computations are run on the +same compute special remote. Now if the user runs `git-annex get foo`, +they will be unhappy if it chooses to run the expensive computation, +rather than the less expensive computation. + +Since the per-special remote state for a key is used as the computation +input, only one input can be saved for foo's key. So it wouldn't really be +picking between two alernatives, it would just use whatever the current +state for that key is. +"""]] diff --git a/doc/todo/compute_special_remote/comment_13_b6b1c8e9dc9e1d818036385fd073ed21._comment b/doc/todo/compute_special_remote/comment_13_b6b1c8e9dc9e1d818036385fd073ed21._comment new file mode 100644 index 0000000000..372c1feb7b --- /dev/null +++ b/doc/todo/compute_special_remote/comment_13_b6b1c8e9dc9e1d818036385fd073ed21._comment @@ -0,0 +1,24 @@ +[[!comment format=mdwn + username="matrss" + avatar="http://cdn.libravatar.org/avatar/cd1c0b3be1af288012e49197918395f0" + subject="comment 13" + date="2025-01-29T09:56:12Z" + content=""" +> @m.risse in your example the \"data.nc\" file gets new content when retrieved from the special remote and the source file has changed. + +True, that can happen, and the user was explicit in that they either don't care about it (non-checksum backend, URL in my PoC), or do care (checksum backend) and git-annex would fail the checksum verification. + +> But if you already have data.nc file present in a repository, it does not get updated immediately when you update the source \"data.grib\" file. +> +> So, a drop and re-get of a file changes the version of the file you have available. For that matter, if the old version has been stored on other remotes, a get may retrieve either an old or a new version. That is not intuitive and it makes me wonder if using a special remote is really a good fit for what you're wanting to do + +This I haven't entirely thought through. I'd say if the key uses a non-checksum backend, then it can only be assumed and is the users responsibility that the resulting file is functionally, even if not bit-by-bit, identical. E.g. with netCDF checksums can differ due to small details like chunking, but the data might be the same. With a checksum backend git-annex would just fail the next recompute, but the interactions with copies on other remotes could indeed get confusing. + +> In your \"cdo\" example, it's not clear to me if the new version of the software generates an identical file to the old, or if it has a bug fix that causes it to generate a significantly different output. If the two outputs are significantly different then treating them as the same git-annex key seems questionable to me. + +Again, two possible cases depending on if the key uses a checksum or a non-checksum backend. With a checksum: if the new version produces the same output everything is fine; if the new version produces different output then git-annex would indicate this discrepancy on the next recompute and the user has to decide how to handle it (probably by checking that the output of the new version is either functionally the same or in some way \"better\" than the old one and updating the repository to record this new key as that file). + +Without a checksum backend the user would again have been explicit in that they don't care if the data changes for whatever reason, the key is essentially just a placeholder for the computation without a guarantee about its content. + +Something like VURL would be a compromise between the two: it would avoid the upfront cost of computing all files (which might be very expensive), but still instruct git-annex to error out if the checksum changes at some point after the first compute. A regular migration of the computed-files-so-far to a checksum backend could achieve the same. +"""]] diff --git a/doc/todo/compute_special_remote/comment_14_f0a575875e1f8809906ba4021e879b43._comment b/doc/todo/compute_special_remote/comment_14_f0a575875e1f8809906ba4021e879b43._comment new file mode 100644 index 0000000000..7d3624c83d --- /dev/null +++ b/doc/todo/compute_special_remote/comment_14_f0a575875e1f8809906ba4021e879b43._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="matrss" + avatar="http://cdn.libravatar.org/avatar/cd1c0b3be1af288012e49197918395f0" + subject="comment 14" + date="2025-01-29T10:13:59Z" + content=""" +Some thoughts regarding your ideas: + +- Multiple output files could always be emulated by generating a single archive file and registering additional compute instructions that simply extract each output file from that archive. I think there could be some convenience functionality on the CLI side to set that up and the key of the archive file might not even need to correspond to an actual file in the tree. +- For my use-cases (and I think DataLad at large) it is important to make this feature work across repository boundaries. E.g. I would like to use this feature to build a derived dataset from , where exactly this conversion from grib to netcdf happens in the compute step. I'd like to have the netcdf outputs as a separate dataset as some users might only be interested in the grib files, and it would scale better when there is more than just one kind of output that can be derived from an input by computation. `git annex get` doesn't work recursively across submodules/subdatasets though, and `datalad get` does not understand keys, just paths (at least so far). +"""]] diff --git a/doc/todo/compute_special_remote/comment_3_573cb6c3ee8d1a2072c61559f81dc32c._comment b/doc/todo/compute_special_remote/comment_3_573cb6c3ee8d1a2072c61559f81dc32c._comment index f4c06b6f7d..c5004caa34 100644 --- a/doc/todo/compute_special_remote/comment_3_573cb6c3ee8d1a2072c61559f81dc32c._comment +++ b/doc/todo/compute_special_remote/comment_3_573cb6c3ee8d1a2072c61559f81dc32c._comment @@ -3,5 +3,5 @@ subject="""comment 3""" date="2024-04-30T19:31:35Z" content=""" -See also [[todo/wishlist__58___derived_content_support]]. +See also [[todo/wishlist:_derived_content_support]]. """]] diff --git a/doc/todo/compute_special_remote/comment_6_f1760976e65ae16d4d79f004ac924e55._comment b/doc/todo/compute_special_remote/comment_6_f1760976e65ae16d4d79f004ac924e55._comment index 69d2f42283..dd71ce09ce 100644 --- a/doc/todo/compute_special_remote/comment_6_f1760976e65ae16d4d79f004ac924e55._comment +++ b/doc/todo/compute_special_remote/comment_6_f1760976e65ae16d4d79f004ac924e55._comment @@ -3,11 +3,30 @@ subject="""comment 6""" date="2024-04-30T19:53:43Z" content=""" -On trust, it seems to me that if someone chooses to enable a particular -special remote, they are choosing to trust whatever kind of computations it -supports. +On trust, it seems to me that if someone chooses to install a +particular special remote, they are choosing to trust whatever kind of +computations it supports. Eg a special remote could choose to always run a computation inside a particular container system and then if you trust that container system is -secure, you can choose to use it. +secure, you can choose to install it. + +Enabling the special remote is not necessary, because a +repository can be set to autoenable a special remote. In some sense this is +surprising. I had originally talked about enabling here and then I +remembered autoenable. + +It may be that autoenable should only be allowed for +special remote programs that the user explicitly whitelists, not only +installs into PATH. That would break some existing workflows, though +setting some git configs would not be too hard. + +There seems scope for both compute special remotes that execute code that +comes from the git repository, and ones that only have metadata about the +computation recorded in the git repository, in a way that cannot let them +execute arbitrary code under the control of the git repository. + +A well-behaved compute special remote that does run code that comes from a +git repository could require an additional git config to be set to allow it +to do that. """]] diff --git a/doc/todo/compute_special_remote/comment_9_2e10caa2ecbba0f53a3ab031a94c9907._comment b/doc/todo/compute_special_remote/comment_9_2e10caa2ecbba0f53a3ab031a94c9907._comment new file mode 100644 index 0000000000..e596f7cd20 --- /dev/null +++ b/doc/todo/compute_special_remote/comment_9_2e10caa2ecbba0f53a3ab031a94c9907._comment @@ -0,0 +1,75 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 9""" + date="2025-01-27T14:46:43Z" + content=""" +Circling back to this, I think the fork in the road is whether this is +about git-annex providing this and that feature to support external special +remotes that compute, or whether git-annex gets a compute special +remote of its own with some simpler/better extension interface +than the external special remote protocol. + +Of course, git-annex having its own compute special remote would not +preclude other external special remotes that compute. And for that matter, +a single external special remote could implement an extension interface. + +--- + +Thinking about how a generic compute special remote in git-annex could +work, multiple instances of it could be initremoted: + + git-annex initremote convertfiles type=compute program=csv-to-xslx + git-annex initremote cutvideo type=compute program=ffmpeg-cut + +Here the "program" parameter would cause a program like +`git-annex-compute-ffmpeg-cut` to be run to get files from that instance +of the compute special remote. The interface could be as simple as it +being run with the key that it is requested to compute, and outputting +the paths to the all keys it was able to compute. (So allowing for +"request one key, receive many".) Perhaps also with some way to indicate +progess of the computation. + +It would make sense to store the details of computations in git-annex +metadata. And a compute program can use git-annex commands to get files +it depends on. Eg, `git-annex-compute-ffmpeg-cut` could run: + + # look up the configured metadata + starttime=$(git-annex metadata --get compute-ffmpeg-starttime --key=$requested) + endtime=$(git-annex metadata --get compute-ffmpeg-endtime --key=$requested) + source=$(git-annex metadata --get compute-ffmpeg-source --key=$requested) + + # get the source video file + git-annex get --key=$source + git-annex examinekey --format='${objectpath}' $source + +It might be worth formalizing that a given computed key can depend on other +keys, and have git-annex always get/compute those keys first. And provide +them to the program in a worktree? + +When asked to store a key in the compute special remote, it would verify +that the key can be generated by it. Using the same interface as used to +get a key. + +This all leaves a chicken and egg problem, how does the user add a computed +file if they don't know the key yet? + +The user could manually run the commands that generate the computed file, +then `git-annex add` it, and set the metadata. Then `git-annex copy --to` +the compute remote would verify if the file can be generated, and add it if +so. This seems awkward, but also nice to be able to do manually. + +Or, something like VURL keys could be used, with an interface something +like this: + + git-annex addcomputed foo --to ffmpeg-cut + --input compute-ffmpeg-source=input.mov + --set compute-ffmpeg-starttime=15:00 + --set compute-ffmpeg-endtime=30:00 + +All that would do is generate some arbitrary VURL key or similar, +provisionally set the provided metadata (how?), and try to store the key +in the compute special remote. If it succeeds, stage an annex pointer +and commit the metadata. Since it's a VURL key, storing the key in the +compute special remote would also record the hash of the generated file +at that point. +"""]] diff --git a/doc/todo/generic_p2p_socket_transport/comment_6_4641d3ad4a8a8f17f8df47e02555dfa2._comment b/doc/todo/generic_p2p_socket_transport/comment_6_4641d3ad4a8a8f17f8df47e02555dfa2._comment new file mode 100644 index 0000000000..ce9a361d40 --- /dev/null +++ b/doc/todo/generic_p2p_socket_transport/comment_6_4641d3ad4a8a8f17f8df47e02555dfa2._comment @@ -0,0 +1,14 @@ +[[!comment format=mdwn + username="matrss" + avatar="http://cdn.libravatar.org/avatar/cd1c0b3be1af288012e49197918395f0" + subject="comment 6" + date="2025-01-27T15:26:15Z" + content=""" +> > If the PSK were fully contained in the remote string then a third-party getting hold of that string could pretend to be the server + +> I agree this would be a problem, but how would a third-party get ahold of the string though? Remote urls don't usually get stored in the git repository, perhaps you were thinking of some other way. + +My thinking was that git remote URLs usually aren't sensitive information that inherently grant access to a repository, so a construct where the remote URL contains the credentials is just unexpected. A careless user might e.g. put it into a `type=git` special remote or treat it in some other way in which one wouldn't treat a password, without considering the implications. I am not aware of a way in which they could be leaked without user intervention, though. + +Having separate credentials explicitly named as such just seems safer. But in the end this would be the responsibility of the one implementing the p2p transport, anyway. +"""]] From 94e177db9dde1ca6fb2f0e4f0943c225f15e5e5f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 29 Jan 2025 19:04:13 -0400 Subject: [PATCH 02/15] document a SNAFU --- doc/todo/RawFilePath_conversion.mdwn | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/doc/todo/RawFilePath_conversion.mdwn b/doc/todo/RawFilePath_conversion.mdwn index 6268d93164..b7d9675b4d 100644 --- a/doc/todo/RawFilePath_conversion.mdwn +++ b/doc/todo/RawFilePath_conversion.mdwn @@ -17,15 +17,14 @@ status. replacing all the RawFilePath with OsPath, which should be pretty mechanical, with only some wrapper functions in Utility.FileIO and Utility.RawFilePath needing to be changed. -* Utility.FileIO is used for most withFile and openFile, but not yet for - readFile, writeFile, and appendFile on FilePaths. - Note that the FilePath versions do newline translation on windows, - which has to be handled when converting to the Utility.FileIO ones. -* System.Directory.OsPath is available with OsPath build flag, but - not yet used, and would eliminate a lot of fromRawFilePaths. - Make Utility.SystemDirectory import it when built with OsPath, - and the remaining 6 hours or work will explain itself.. - This has been started in the `ospath` branch. + + An attempt was made on this, which is in the `ospath` branch. It + is unfinished and doesn't build. Some of the groundwork for that + culminated in [[!commit aaf4dd3b9cc71752624dd81352c242eeabe912c2]] + which builds and passes the test suite... except for on windows, where it + fails both with and without the new OsPath build flag it added, in + different and both surprising and seemingly difficult to understand ways. + That has caused me to give up on it for now. [[!tag confirmed]] From 8ed173481a8d3593f0f4152efc3c829abe70588b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 29 Jan 2025 19:05:37 -0400 Subject: [PATCH 03/15] close --- .../FTBFS_for_the_past_week__58___Variable_not_in_scope.mdwn | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/bugs/FTBFS_for_the_past_week__58___Variable_not_in_scope.mdwn b/doc/bugs/FTBFS_for_the_past_week__58___Variable_not_in_scope.mdwn index 14da37c15f..46d29678d7 100644 --- a/doc/bugs/FTBFS_for_the_past_week__58___Variable_not_in_scope.mdwn +++ b/doc/bugs/FTBFS_for_the_past_week__58___Variable_not_in_scope.mdwn @@ -62,4 +62,4 @@ make[3]: *** [Makefile:156: Build/Standalone] Error 1 make[3]: Leaving directory '/home/runner/work/git-annex/git-annex/git-annex-source' make[2]: *** [Makefile:164: linuxstandalone] Error 2 ``` - +> [[done]] --[[Joey]] From cfe960bf5e5f85bd504ea6ce6361dbd4f8edb2fd Mon Sep 17 00:00:00 2001 From: "beryllium@5bc3c32eb8156390f96e363e4ba38976567425ec" Date: Thu, 30 Jan 2025 02:35:09 +0000 Subject: [PATCH 04/15] --- .../git-lfs_special_insists_on_https.mdwn | 68 +++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 doc/bugs/git-lfs_special_insists_on_https.mdwn diff --git a/doc/bugs/git-lfs_special_insists_on_https.mdwn b/doc/bugs/git-lfs_special_insists_on_https.mdwn new file mode 100644 index 0000000000..62c62f438a --- /dev/null +++ b/doc/bugs/git-lfs_special_insists_on_https.mdwn @@ -0,0 +1,68 @@ +### Please describe the problem. + +Trying to copy annexed files to an lfs server via the configured http schemed url results in an error of this form: + +[[!format sh """ +$ git-annex copy -t lfsonly +copy mod_access_compat.so (HttpExceptionRequest Request { + host = "computer-ubul.local" + port = 5965 + secure = True + requestHeaders = [("Accept","application/vnd.git-lfs+json"),("Content-Type","application/vnd.git-lfs+json"),("User-Agent","git-annex/10.20241031-1~ndall+1")] + path = ".git/info/lfs/objects/batch" + queryString = "" + method = "POST" + proxy = Nothing + rawBody = False + redirectCount = 10 + responseTimeout = ResponseTimeoutDefault + requestVersion = HTTP/1.1 + proxySecureMode = ProxySecureWithConnect +} + (InternalException (HandshakeFailed (Error_Packet_Parsing "Failed reading: invalid header type: 72\nFrom:\theader\n\n")))) failed +copy mod_autoindex.so (HttpExceptionRequest Request { + host = "computer-ubul.local" + port = 5965 + secure = True + requestHeaders = [("Accept","application/vnd.git-lfs+json"),("Content-Type","application/vnd.git-lfs+json"),("User-Agent","git-annex/10.20241031-1~ndall+1")] + path = ".git/info/lfs/objects/batch" + queryString = "" + method = "POST" + proxy = Nothing + rawBody = False + redirectCount = 10 + responseTimeout = ResponseTimeoutDefault + requestVersion = HTTP/1.1 + proxySecureMode = ProxySecureWithConnect +} + (InternalException (HandshakeFailed (Error_Packet_Parsing "Failed reading: invalid header type: 72\nFrom:\theader\n\n")))) failed +copy: 2 failed +"""]] + +From what I can see, there is no way to work around this. Unlike, for example, the S3 special remotes, initremote doesn't take a protocol=http setting. + + +### What steps will reproduce the problem? + +[[!format sh """ +$ git-annex initremote lfsonly type=git-lfs encryption=none url=http://computer-ubul.local:5965/ +initremote lfsonly ok +(recording state in git...) +$ git config annex.security.allowed-ip-addresses 172.17.0.1 # required to overcome ConnectionRestricted error +$ git-annex copy -t lfsonly +... eror from above +"""]] + +### What version of git-annex are you using? On what operating system? + +git-annex/10.20241031-1~ndall+1 on Ubuntu 22.04 LTS: + +Linux computer-ubul 6.8.0-40-generic #40~22.04.3-Ubuntu SMP PREEMPT_DYNAMIC Tue Jul 30 17:30:19 UTC 2 x86_64 x86_64 x86_64 GNU/Linux + +### Please provide any additional information below. + +Nil + +### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders) + +Love git-annex. Long time supporter. From 0afb8eab26e6f76d63a890e7ce724ccc3b026adc Mon Sep 17 00:00:00 2001 From: nobodyinperson Date: Thu, 30 Jan 2025 12:59:00 +0000 Subject: [PATCH 05/15] --- doc/forum/Forcing_offline_behavior.mdwn | 1 + 1 file changed, 1 insertion(+) create mode 100644 doc/forum/Forcing_offline_behavior.mdwn diff --git a/doc/forum/Forcing_offline_behavior.mdwn b/doc/forum/Forcing_offline_behavior.mdwn new file mode 100644 index 0000000000..a11989e06e --- /dev/null +++ b/doc/forum/Forcing_offline_behavior.mdwn @@ -0,0 +1 @@ +It seems that things like `git annex wanted . present` cause network activity, maybe git-annex fetches remotes and tries to look up IDs and such. I didn't find a general flag to disables this. Something like `--offline` would be nice for scripts in networks that might hang indefinitely in certain situations. Does this exist? 🤔 From 0d339831410e1468e153ada66d25bf4bb2d74113 Mon Sep 17 00:00:00 2001 From: dmcardle Date: Thu, 30 Jan 2025 13:56:30 +0000 Subject: [PATCH 06/15] Added a comment --- .../comment_2_f65aeea70b85745de1fbecb6fcce66d1._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/forum/b2_rclone_initremote_failed__58___empty_folders/comment_2_f65aeea70b85745de1fbecb6fcce66d1._comment diff --git a/doc/forum/b2_rclone_initremote_failed__58___empty_folders/comment_2_f65aeea70b85745de1fbecb6fcce66d1._comment b/doc/forum/b2_rclone_initremote_failed__58___empty_folders/comment_2_f65aeea70b85745de1fbecb6fcce66d1._comment new file mode 100644 index 0000000000..85b5e78c61 --- /dev/null +++ b/doc/forum/b2_rclone_initremote_failed__58___empty_folders/comment_2_f65aeea70b85745de1fbecb6fcce66d1._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="dmcardle" + avatar="http://cdn.libravatar.org/avatar/b79468a0d03ec3ec7acbae547c4fa994" + subject="comment 2" + date="2025-01-30T13:56:30Z" + content=""" +I just created rclone [issue #8349](https://github.com/rclone/rclone/issues/8349) to track this. +"""]] From eab8aec4f01e843e4fe479c751f04b723d6239ee Mon Sep 17 00:00:00 2001 From: matrss Date: Thu, 30 Jan 2025 14:50:58 +0000 Subject: [PATCH 07/15] --- doc/git-annex.mdwn | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 869686883a..620aee61cd 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -341,25 +341,25 @@ content from the key-value store. Initializes a new cluster. - See [[git-annex-initcluster](1) for details. + See [[git-annex-initcluster]](1) for details. * `updatecluster` Update records of cluster nodes. - See [[git-annex-updatecluster](1) for details. + See [[git-annex-updatecluster]](1) for details. * `extendcluster` Adds an additional gateway to a cluster. - See [[git-annex-extendcluster](1) for details. + See [[git-annex-extendcluster]](1) for details. * `updateproxy` Update records with proxy configuration. - See [[git-annex-updateproxy](1) for details. + See [[git-annex-updateproxy]](1) for details. * `schedule repository [expression]` From 34d969fa086b3c2d62b509b1645c22fb1e6502d4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Jan 2025 13:24:51 -0400 Subject: [PATCH 08/15] switch appveyor windows build to newer version --- .appveyor.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.appveyor.yml b/.appveyor.yml index 428159e0ff..2525c11167 100644 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -52,7 +52,7 @@ environment: # Windows core tests - ID: WinP39core - APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2019 + APPVEYOR_BUILD_WORKER_IMAGE: Visual Studio 2022 STACK_ROOT: "c:\\sr" # MacOS core tests - ID: MacP38core From 84291b6014e7bb3007029aa0ec1cced5ce4b38cd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Jan 2025 14:34:21 -0400 Subject: [PATCH 09/15] bring back OsPath changes I hope that the windows test suite failure on appveyor was fixed by updating to a newer windows there. I have not been able to reproduce that failure in a windows 11 VM run locally. --- Annex/AdjustedBranch.hs | 11 +-- Annex/AdjustedBranch/Merge.hs | 22 ++--- Annex/AutoMerge.hs | 13 +-- Annex/Balanced.hs | 3 +- Annex/Branch.hs | 25 +++--- Annex/ChangedRefs.hs | 4 +- Annex/Content.hs | 15 ++-- Annex/Content/PointerFile.hs | 5 +- Annex/Fixup.hs | 1 + Annex/Hook.hs | 7 +- Annex/Ingest.hs | 21 +++-- Annex/Journal.hs | 15 ++-- Annex/Link.hs | 15 ++-- Annex/Proxy.hs | 6 +- Annex/ReplaceFile.hs | 39 +++------ Annex/RepoSize/LiveUpdate.hs | 2 +- Annex/Ssh.hs | 30 ++++--- Annex/Tmp.hs | 10 ++- Annex/VectorClock.hs | 3 +- Annex/VectorClock/Utility.hs | 3 +- Annex/YoutubeDl.hs | 17 ++-- Assistant/DaemonStatus.hs | 9 +- Assistant/Install.hs | 30 ++++--- Assistant/Repair.hs | 19 ++-- Assistant/Ssh.hs | 7 +- Assistant/Threads/TransferPoller.hs | 2 +- Assistant/Threads/TransferWatcher.hs | 8 +- Assistant/Threads/Watcher.hs | 2 +- Assistant/Threads/WebApp.hs | 4 +- Assistant/Upgrade.hs | 23 ++--- Assistant/WebApp/Configurators/Delete.hs | 2 +- Assistant/WebApp/Configurators/Ssh.hs | 6 +- Backend/Utilities.hs | 10 +-- Build/LinuxMkLibs.hs | 7 +- Build/Standalone.hs | 22 ++--- Build/Version.hs | 14 +-- CHANGELOG | 1 + CmdLine/GitRemoteAnnex.hs | 40 +++++---- CmdLine/Seek.hs | 6 +- Command/AddUrl.hs | 23 +++-- Command/Export.hs | 4 +- Command/Fix.hs | 6 +- Command/Fsck.hs | 7 +- Command/ImportFeed.hs | 7 +- Command/Lock.hs | 2 +- Command/Multicast.hs | 10 +-- Command/P2P.hs | 21 ++--- Command/P2PHttp.hs | 4 +- Command/ReKey.hs | 2 +- Command/ResolveMerge.hs | 11 ++- Command/TestRemote.hs | 23 ++--- Command/Uninit.hs | 10 +-- Command/Unlock.hs | 2 +- Command/Vicfg.hs | 10 ++- Common.hs | 2 + Config/Files/AutoStart.hs | 4 +- Config/Smudge.hs | 16 ++-- Creds.hs | 16 ++-- Crypto.hs | 4 +- Database/Benchmark.hs | 2 +- Git/HashObject.hs | 6 +- Git/Hook.hs | 32 +++---- Git/LsFiles.hs | 2 +- Git/Objects.hs | 10 +-- Git/Ref.hs | 9 +- Git/Repair.hs | 46 +++++----- Logs/AdjustedBranchUpdate.hs | 2 +- Logs/Export.hs | 3 +- Logs/File.hs | 72 ++++----------- Logs/Migrate.hs | 2 +- Logs/Restage.hs | 6 +- Logs/Smudge.hs | 2 +- Logs/Transfer.hs | 30 ++++--- Logs/Unused.hs | 11 +-- Logs/Upgrade.hs | 11 +-- Remote/BitTorrent.hs | 25 +++--- Remote/Directory.hs | 47 +++++----- Remote/Directory/LegacyChunked.hs | 7 +- Remote/GCrypt.hs | 11 +-- Remote/Git.hs | 7 +- Remote/Helper/Git.hs | 9 +- Remote/Rsync.hs | 2 +- Test.hs | 4 +- Test/Framework.hs | 8 +- Types/Direction.hs | 2 +- Types/Distribution.hs | 7 +- Upgrade/V1.hs | 8 +- Upgrade/V2.hs | 22 +++-- Upgrade/V5.hs | 9 +- Upgrade/V5/Direct.hs | 9 +- Upgrade/V7.hs | 8 +- Utility/Daemon.hs | 2 +- Utility/DirWatcher/FSEvents.hs | 3 +- Utility/DirWatcher/INotify.hs | 2 +- Utility/DirWatcher/Kqueue.hs | 2 +- Utility/DirWatcher/Win32Notify.hs | 3 +- Utility/Directory.hs | 48 +++++----- Utility/Directory/Stream.hs | 34 +++---- Utility/FileIO.hs | 107 +++++++++++++++++++++++ Utility/FileMode.hs | 4 +- Utility/FileSize.hs | 5 +- Utility/FileSystemEncoding.hs | 38 +++++--- Utility/Gpg.hs | 4 +- Utility/HtmlDetect.hs | 7 +- Utility/InodeCache.hs | 2 +- Utility/LinuxMkLibs.hs | 1 + Utility/LockFile/PidLock.hs | 17 ++-- Utility/LockFile/Windows.hs | 2 +- Utility/Misc.hs | 60 +++++++++++-- Utility/MoveFile.hs | 10 ++- Utility/OsPath.hs | 65 ++++++++++++++ Utility/SshConfig.hs | 13 +-- Utility/StatelessOpenPGP.hs | 6 +- Utility/TimeStamp.hs | 7 +- Utility/Tmp.hs | 78 ++++++++++------- Utility/Tmp/Dir.hs | 6 +- Utility/WebApp.hs | 4 +- git-annex.cabal | 15 ++++ stack.yaml | 11 ++- 119 files changed, 1003 insertions(+), 647 deletions(-) create mode 100644 Utility/FileIO.hs create mode 100644 Utility/OsPath.hs diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 56a617db44..5d5458fa82 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -70,6 +70,7 @@ import Logs.View (is_branchView) import Logs.AdjustedBranchUpdate import Utility.FileMode import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import Data.Time.Clock.POSIX import qualified Data.Map as M @@ -268,7 +269,7 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch -- origbranch. _ <- propigateAdjustedCommits' True origbranch adj commitlck - origheadfile <- inRepo $ readFileStrict . Git.Ref.headFile + origheadfile <- inRepo $ F.readFile' . toOsPath . Git.Ref.headFile origheadsha <- inRepo (Git.Ref.sha currbranch) b <- adjustBranch adj origbranch @@ -280,8 +281,8 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch newheadfile <- case origheadsha of Just s -> do inRepo $ \r -> do - let newheadfile = fromRef s - writeFile (Git.Ref.headFile r) newheadfile + let newheadfile = fromRef' s + F.writeFile' (toOsPath (Git.Ref.headFile r)) newheadfile return (Just newheadfile) _ -> return Nothing @@ -295,9 +296,9 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch unless ok $ case newheadfile of Nothing -> noop Just v -> preventCommits $ \_commitlck -> inRepo $ \r -> do - v' <- readFileStrict (Git.Ref.headFile r) + v' <- F.readFile' (toOsPath (Git.Ref.headFile r)) when (v == v') $ - writeFile (Git.Ref.headFile r) origheadfile + F.writeFile' (toOsPath (Git.Ref.headFile r)) origheadfile return ok | otherwise = preventCommits $ \commitlck -> do diff --git a/Annex/AdjustedBranch/Merge.hs b/Annex/AdjustedBranch/Merge.hs index 904f4ee412..7817bdbeca 100644 --- a/Annex/AdjustedBranch/Merge.hs +++ b/Annex/AdjustedBranch/Merge.hs @@ -29,8 +29,9 @@ import Annex.GitOverlay import Utility.Tmp.Dir import Utility.CopyFile import Utility.Directory.Create +import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F -import qualified Data.ByteString as S import qualified System.FilePath.ByteString as P canMergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Annex Bool @@ -72,26 +73,25 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm -} changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do git_dir <- fromRepo Git.localGitDir - let git_dir' = fromRawFilePath git_dir tmpwt <- fromRepo gitAnnexMergeDir - withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $ + withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath "git") $ \tmpgit -> withWorkTreeRelated tmpgit $ withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do + let tmpgit' = toRawFilePath tmpgit liftIO $ writeFile (tmpgit "HEAD") (fromRef updatedorig) -- Copy in refs and packed-refs, to work -- around bug in git 2.13.0, which -- causes it not to look in GIT_DIR for refs. refs <- liftIO $ emptyWhenDoesNotExist $ dirContentsRecursive $ - git_dir' "refs" - let refs' = (git_dir' "packed-refs") : refs + git_dir P. "refs" + let refs' = (git_dir P. "packed-refs") : refs liftIO $ forM_ refs' $ \src -> do - let src' = toRawFilePath src - whenM (doesFileExist src) $ do - dest <- relPathDirToFile git_dir src' - let dest' = toRawFilePath tmpgit P. dest + whenM (R.doesPathExist src) $ do + dest <- relPathDirToFile git_dir src + let dest' = tmpgit' P. dest createDirectoryUnder [git_dir] (P.takeDirectory dest') - void $ createLinkOrCopy src' dest' + void $ createLinkOrCopy src dest' -- This reset makes git merge not care -- that the work tree is empty; otherwise -- it will think that all the files have @@ -107,7 +107,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm if merged then do !mergecommit <- liftIO $ extractSha - <$> S.readFile (tmpgit "HEAD") + <$> F.readFile' (toOsPath (tmpgit' P. "HEAD")) -- This is run after the commit lock is dropped. return $ postmerge mergecommit else return $ return False diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index bb43d0593b..0c0c203688 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -35,10 +35,10 @@ import Annex.InodeSentinal import Utility.InodeCache import Utility.FileMode import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified Data.Set as S import qualified Data.Map as M -import qualified Data.ByteString.Lazy as L import System.PosixCompat.Files (isSymbolicLink) {- Merges from a branch into the current branch (which may not exist yet), @@ -236,8 +236,9 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do | otherwise = pure f makesymlink key dest = do - l <- calcRepo $ gitAnnexLink (toRawFilePath dest) key - unless inoverlay $ replacewithsymlink dest l + let rdest = toRawFilePath dest + l <- calcRepo $ gitAnnexLink rdest key + unless inoverlay $ replacewithsymlink rdest l dest' <- toRawFilePath <$> stagefile dest stageSymlink dest' =<< hashSymlink l @@ -265,9 +266,9 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do let replacefile isexecutable = case selectwant' (LsFiles.unmergedSha u) of Nothing -> noop - Just sha -> replaceWorkTreeFile item $ \tmp -> do + Just sha -> replaceWorkTreeFile (toRawFilePath item) $ \tmp -> do c <- catObject sha - liftIO $ L.writeFile (decodeBS tmp) c + liftIO $ F.writeFile (toOsPath tmp) c when isexecutable $ liftIO $ void $ tryIO $ modifyFileMode tmp $ @@ -280,7 +281,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do Nothing -> noop Just sha -> do link <- catSymLinkTarget sha - replacewithsymlink item link + replacewithsymlink (toRawFilePath item) link (Just TreeFile, Just TreeSymlink) -> replacefile False (Just TreeExecutable, Just TreeSymlink) -> replacefile True _ -> ifM (liftIO $ doesDirectoryExist item) diff --git a/Annex/Balanced.hs b/Annex/Balanced.hs index ab643287d6..e114c1f893 100644 --- a/Annex/Balanced.hs +++ b/Annex/Balanced.hs @@ -11,11 +11,12 @@ import Key import Types.UUID import Utility.Hash -import Data.List import Data.Maybe import Data.Bits (shiftL) import qualified Data.Set as S import qualified Data.ByteArray as BA +import Data.List +import Prelude -- The Int is how many UUIDs to pick. type BalancedPicker = S.Set UUID -> Key -> Int -> [UUID] diff --git a/Annex/Branch.hs b/Annex/Branch.hs index ce4c3ad85e..dd7dc03255 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -96,6 +96,7 @@ import Annex.Hook import Utility.Directory.Stream import Utility.Tmp import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F {- Name of the branch that is used to store git-annex's information. -} name :: Git.Ref @@ -711,9 +712,9 @@ forceUpdateIndex jl branchref = do {- Checks if the index needs to be updated. -} needUpdateIndex :: Git.Ref -> Annex Bool needUpdateIndex branchref = do - f <- fromRawFilePath <$> fromRepo gitAnnexIndexStatus + f <- toOsPath <$> fromRepo gitAnnexIndexStatus committedref <- Git.Ref . firstLine' <$> - liftIO (catchDefaultIO mempty $ B.readFile f) + liftIO (catchDefaultIO mempty $ F.readFile' f) return (committedref /= branchref) {- Record that the branch's index has been updated to correspond to a @@ -741,7 +742,7 @@ stageJournal jl commitindex = withIndex $ withOtherTmp $ \tmpdir -> do g <- gitRepo st <- getState let dir = gitAnnexJournalDir st g - (jlogf, jlogh) <- openjlog (fromRawFilePath tmpdir) + (jlogf, jlogh) <- openjlog tmpdir withHashObjectHandle $ \h -> withJournalHandle gitAnnexJournalDir $ \jh -> Git.UpdateIndex.streamUpdateIndex g @@ -752,12 +753,12 @@ stageJournal jl commitindex = withIndex $ withOtherTmp $ \tmpdir -> do genstream dir h jh jlogh streamer = readDirectory jh >>= \case Nothing -> return () Just file -> do - let path = dir P. toRawFilePath file + let path = dir P. file unless (dirCruft file) $ whenM (isfile path) $ do sha <- Git.HashObject.hashFile h path - hPutStrLn jlogh file + B.hPutStr jlogh (file <> "\n") streamer $ Git.UpdateIndex.updateIndexLine - sha TreeFile (asTopFilePath $ fileJournal $ toRawFilePath file) + sha TreeFile (asTopFilePath $ fileJournal file) genstream dir h jh jlogh streamer isfile file = isRegularFile <$> R.getFileStatus file -- Clean up the staged files, as listed in the temp log file. @@ -769,8 +770,8 @@ stageJournal jl commitindex = withIndex $ withOtherTmp $ \tmpdir -> do stagedfs <- lines <$> hGetContents jlogh mapM_ (removeFile . (dir )) stagedfs hClose jlogh - removeWhenExistsWith (R.removeLink) (toRawFilePath jlogf) - openjlog tmpdir = liftIO $ openTmpFileIn tmpdir "jlog" + removeWhenExistsWith (R.removeLink) (fromOsPath jlogf) + openjlog tmpdir = liftIO $ openTmpFileIn (toOsPath tmpdir) (toOsPath "jlog") getLocalTransitions :: Annex Transitions getLocalTransitions = @@ -931,8 +932,8 @@ getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . fileLines' <$> content where content = do - f <- fromRawFilePath <$> fromRepo gitAnnexIgnoredRefs - liftIO $ catchDefaultIO mempty $ B.readFile f + f <- toOsPath <$> fromRepo gitAnnexIgnoredRefs + liftIO $ catchDefaultIO mempty $ F.readFile' f addMergedRefs :: [(Git.Sha, Git.Branch)] -> Annex () addMergedRefs [] = return () @@ -949,8 +950,8 @@ getMergedRefs = S.fromList . map fst <$> getMergedRefs' getMergedRefs' :: Annex [(Git.Sha, Git.Branch)] getMergedRefs' = do - f <- fromRawFilePath <$> fromRepo gitAnnexMergedRefs - s <- liftIO $ catchDefaultIO mempty $ B.readFile f + f <- toOsPath <$> fromRepo gitAnnexMergedRefs + s <- liftIO $ catchDefaultIO mempty $ F.readFile' f return $ map parse $ fileLines' s where parse l = diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs index 7a9ce8a34f..073686fb01 100644 --- a/Annex/ChangedRefs.hs +++ b/Annex/ChangedRefs.hs @@ -23,11 +23,11 @@ import Utility.Directory.Create import qualified Git import Git.Sha import qualified Utility.SimpleProtocol as Proto +import qualified Utility.FileIO as F import Control.Concurrent import Control.Concurrent.STM import Control.Concurrent.STM.TBMChan -import qualified Data.ByteString as S import qualified System.FilePath.ByteString as P newtype ChangedRefs = ChangedRefs [Git.Ref] @@ -104,7 +104,7 @@ notifyHook chan reffile _ | ".lock" `isSuffixOf` reffile = noop | otherwise = void $ do sha <- catchDefaultIO Nothing $ - extractSha <$> S.readFile reffile + extractSha <$> F.readFile' (toOsPath (toRawFilePath reffile)) -- When the channel is full, there is probably no reader -- running, or ref changes have been occurring very fast, -- so it's ok to not write the change to it. diff --git a/Annex/Content.hs b/Annex/Content.hs index aba53add7b..3f26c0f0a8 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -108,6 +108,7 @@ import Utility.HumanTime import Utility.TimeStamp import Utility.FileMode import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isSymbolicLink, linkCount) @@ -581,7 +582,7 @@ linkToAnnex key src srcic = ifM (checkSecureHashes' key) -} linkFromAnnex :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult linkFromAnnex key dest destmode = - replaceFile' (const noop) (fromRawFilePath dest) (== LinkAnnexOk) $ \tmp -> + replaceFile' (const noop) dest (== LinkAnnexOk) $ \tmp -> linkFromAnnex' key tmp destmode {- This is only safe to use when dest is not a worktree file. -} @@ -817,7 +818,7 @@ listKeys' keyloc want = do s <- Annex.getState id r <- Annex.getRead id depth <- gitAnnexLocationDepth <$> Annex.getGitConfig - liftIO $ walk (s, r) depth (fromRawFilePath dir) + liftIO $ walk (s, r) depth dir where walk s depth dir = do contents <- catchDefaultIO [] (dirContents dir) @@ -825,7 +826,7 @@ listKeys' keyloc want = do then do contents' <- filterM present contents keys <- filterM (Annex.eval s . want) $ - mapMaybe (fileKey . P.takeFileName . toRawFilePath) contents' + mapMaybe (fileKey . P.takeFileName) contents' continue keys [] else do let deeper = walk s (depth - 1) @@ -843,8 +844,8 @@ listKeys' keyloc want = do present _ | inanywhere = pure True present d = presentInAnnex d - presentInAnnex = doesFileExist . contentfile - contentfile d = d takeFileName d + presentInAnnex = R.doesPathExist . contentfile + contentfile d = d P. P.takeFileName d {- Things to do to record changes to content when shutting down. - @@ -1076,7 +1077,7 @@ writeContentRetentionTimestamp key rt t = do modifyContentDirWhenExists lckfile $ bracket (lock lckfile) unlock $ \_ -> readContentRetentionTimestamp rt >>= \case Just ts | ts >= t -> return () - _ -> replaceFile (const noop) (fromRawFilePath rt) $ \tmp -> + _ -> replaceFile (const noop) rt $ \tmp -> liftIO $ writeFile (fromRawFilePath tmp) $ show t where lock = takeExclusiveLock @@ -1086,7 +1087,7 @@ writeContentRetentionTimestamp key rt t = do readContentRetentionTimestamp :: RawFilePath -> Annex (Maybe POSIXTime) readContentRetentionTimestamp rt = liftIO $ join <$> tryWhenExists - (parsePOSIXTime <$> readFile (fromRawFilePath rt)) + (parsePOSIXTime <$> F.readFile' (toOsPath rt)) {- Checks if the retention timestamp is in the future, if so returns - Nothing. diff --git a/Annex/Content/PointerFile.hs b/Annex/Content/PointerFile.hs index c2acc9ab93..5dc4d0210b 100644 --- a/Annex/Content/PointerFile.hs +++ b/Annex/Content/PointerFile.hs @@ -34,10 +34,9 @@ populatePointerFile :: Restage -> Key -> RawFilePath -> RawFilePath -> Annex (Ma populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f) where go (Just k') | k == k' = do - let f' = fromRawFilePath f destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus f liftIO $ removeWhenExistsWith R.removeLink f - (ic, populated) <- replaceWorkTreeFile f' $ \tmp -> do + (ic, populated) <- replaceWorkTreeFile f $ \tmp -> do ok <- linkOrCopy k obj tmp destmode >>= \case Just _ -> thawContent tmp >> return True Nothing -> liftIO (writePointerFile tmp k destmode) >> return False @@ -58,7 +57,7 @@ depopulatePointerFile key file = do let mode = fmap fileMode st secureErase file liftIO $ removeWhenExistsWith R.removeLink file - ic <- replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do + ic <- replaceWorkTreeFile file $ \tmp -> do liftIO $ writePointerFile tmp key mode #if ! defined(mingw32_HOST_OS) -- Don't advance mtime; this avoids unnecessary re-smudging diff --git a/Annex/Fixup.hs b/Annex/Fixup.hs index a60e4baa0b..112c55224a 100644 --- a/Annex/Fixup.hs +++ b/Annex/Fixup.hs @@ -19,6 +19,7 @@ import Utility.Directory import Utility.Exception import Utility.Monad import Utility.FileSystemEncoding +import Utility.SystemDirectory import qualified Utility.RawFilePath as R import Utility.PartialPrelude diff --git a/Annex/Hook.hs b/Annex/Hook.hs index 0496094be8..3241d3b556 100644 --- a/Annex/Hook.hs +++ b/Annex/Hook.hs @@ -9,6 +9,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Annex.Hook where import Annex.Common @@ -85,7 +87,8 @@ hookWarning :: Git.Hook -> String -> Annex () hookWarning h msg = do r <- gitRepo warning $ UnquotedString $ - Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg + fromRawFilePath (Git.hookName h) ++ + " hook (" ++ fromRawFilePath (Git.hookFile h r) ++ ") " ++ msg {- To avoid checking if the hook exists every time, the existing hooks - are cached. -} @@ -118,7 +121,7 @@ runAnnexHook' hook commandcfg = ifM (doesAnnexHookExist hook) ( return Nothing , do h <- fromRepo (Git.hookFile hook) - commandfailed h + commandfailed (fromRawFilePath h) ) runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case Nothing -> return Nothing diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index ae430dc89b..ed7479526f 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -118,20 +118,21 @@ lockDown' cfg file = tryNonAsync $ ifM crippledFileSystem withhardlink tmpdir = do setperms withTSDelta $ \delta -> liftIO $ do - (tmpfile, h) <- openTmpFileIn (fromRawFilePath tmpdir) $ - relatedTemplate $ "ingest-" ++ takeFileName file + (tmpfile, h) <- openTmpFileIn (toOsPath tmpdir) $ + relatedTemplate $ toRawFilePath $ + "ingest-" ++ takeFileName file hClose h - removeWhenExistsWith R.removeLink (toRawFilePath tmpfile) - withhardlink' delta tmpfile + let tmpfile' = fromOsPath tmpfile + removeWhenExistsWith R.removeLink tmpfile' + withhardlink' delta tmpfile' `catchIO` const (nohardlink' delta) withhardlink' delta tmpfile = do - let tmpfile' = toRawFilePath tmpfile - R.createLink file' tmpfile' - cache <- genInodeCache tmpfile' delta + R.createLink file' tmpfile + cache <- genInodeCache tmpfile delta return $ LockedDown cfg $ KeySource { keyFilename = file' - , contentLocation = tmpfile' + , contentLocation = tmpfile , inodeCache = cache } @@ -308,7 +309,7 @@ restoreFile file key e = do makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do l <- calcRepo $ gitAnnexLink file key - replaceWorkTreeFile file' $ makeAnnexLink l + replaceWorkTreeFile file $ makeAnnexLink l -- touch symlink to have same time as the original file, -- as provided in the InodeCache @@ -317,8 +318,6 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do Nothing -> noop return l - where - file' = fromRawFilePath file {- Creates the symlink to the annexed content, and stages it in git. -} addSymlink :: RawFilePath -> Key -> Maybe InodeCache -> Annex () diff --git a/Annex/Journal.hs b/Annex/Journal.hs index 8eb1dc880f..cfa582c65e 100644 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -27,6 +27,7 @@ import Annex.BranchState import Types.BranchState import Utility.Directory.Stream import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified Data.Set as S import qualified Data.ByteString.Lazy as L @@ -92,7 +93,7 @@ setJournalFile _jl ru file content = withOtherTmp $ \tmp -> do -- journal file is written atomically let jfile = journalFile file let tmpfile = tmp P. jfile - liftIO $ withFile (fromRawFilePath tmpfile) WriteMode $ \h -> + liftIO $ F.withFile (toOsPath tmpfile) WriteMode $ \h -> writeJournalHandle h content let dest = jd P. jfile let mv = do @@ -133,7 +134,7 @@ checkCanAppendJournalFile _jl ru file = do -} appendJournalFile :: Journalable content => JournalLocked -> AppendableJournalFile -> content -> Annex () appendJournalFile _jl (AppendableJournalFile (jd, jfile)) content = do - let write = liftIO $ withFile (fromRawFilePath jfile) ReadWriteMode $ \h -> do + let write = liftIO $ F.withFile (toOsPath jfile) ReadWriteMode $ \h -> do sz <- hFileSize h when (sz /= 0) $ do hSeek h SeekFromEnd (-1) @@ -204,7 +205,7 @@ getJournalFileStale (GetPrivate getprivate) file = do jfile = journalFile file getfrom d = catchMaybeIO $ discardIncompleteAppend . L.fromStrict - <$> B.readFile (fromRawFilePath (d P. jfile)) + <$> F.readFile' (toOsPath (d P. jfile)) -- Note that this forces read of the whole lazy bytestring. discardIncompleteAppend :: L.ByteString -> L.ByteString @@ -243,17 +244,15 @@ withJournalHandle getjournaldir a = do where -- avoid overhead of creating the journal directory when it already -- exists - opendir d = liftIO (openDirectory (fromRawFilePath d)) + opendir d = liftIO (openDirectory d) `catchIO` (const (createAnnexDirectory d >> opendir d)) {- Checks if there are changes in the journal. -} journalDirty :: (BranchState -> Git.Repo -> RawFilePath) -> Annex Bool journalDirty getjournaldir = do st <- getState - d <- fromRawFilePath <$> fromRepo (getjournaldir st) - liftIO $ - (not <$> isDirectoryEmpty d) - `catchIO` (const $ doesDirectoryExist d) + d <- fromRepo (getjournaldir st) + liftIO $ isDirectoryPopulated d {- Produces a filename to use in the journal for a file on the branch. - The filename does not include the journal directory. diff --git a/Annex/Link.hs b/Annex/Link.hs index 4961499f62..4c2a76ffc2 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -38,6 +38,7 @@ import Utility.Tmp.Dir import Utility.CopyFile import qualified Database.Keys.Handle import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 @@ -87,7 +88,7 @@ getAnnexLinkTarget' file coresymlinks = if coresymlinks probesymlink = R.readSymbolicLink file - probefilecontent = withFile (fromRawFilePath file) ReadMode $ \h -> do + probefilecontent = F.withFile (toOsPath file) ReadMode $ \h -> do s <- S.hGet h maxSymlinkSz -- If we got the full amount, the file is too large -- to be a symlink target. @@ -117,7 +118,7 @@ makeGitLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig) ( liftIO $ do void $ tryIO $ R.removeLink file R.createSymbolicLink linktarget file - , liftIO $ S.writeFile (fromRawFilePath file) linktarget + , liftIO $ F.writeFile' (toOsPath file) linktarget ) {- Creates a link on disk, and additionally stages it in git. -} @@ -152,7 +153,7 @@ stagePointerFile file mode sha = writePointerFile :: RawFilePath -> Key -> Maybe FileMode -> IO () writePointerFile file k mode = do - S.writeFile (fromRawFilePath file) (formatPointer k) + F.writeFile' (toOsPath file) (formatPointer k) maybe noop (R.setFileMode file) mode newtype Restage = Restage Bool @@ -245,7 +246,9 @@ restagePointerFiles r = unlessM (Annex.getState Annex.insmudgecleanfilter) $ do when (numfiles > 0) $ bracket lockindex unlockindex go where - withtmpdir = withTmpDirIn (fromRawFilePath $ Git.localGitDir r) "annexindex" + withtmpdir = withTmpDirIn + (fromRawFilePath $ Git.localGitDir r) + (toOsPath "annexindex") isunmodified tsd f orig = genInodeCache f tsd >>= return . \case @@ -434,7 +437,7 @@ maxSymlinkSz = 8192 isPointerFile :: RawFilePath -> IO (Maybe Key) isPointerFile f = catchDefaultIO Nothing $ #if defined(mingw32_HOST_OS) - withFile (fromRawFilePath f) ReadMode readhandle + F.withFile (toOsPath f) ReadMode readhandle #else #if MIN_VERSION_unix(2,8,0) let open = do @@ -445,7 +448,7 @@ isPointerFile f = catchDefaultIO Nothing $ #else ifM (isSymbolicLink <$> R.getSymbolicLinkStatus f) ( return Nothing - , withFile (fromRawFilePath f) ReadMode readhandle + , F.withFile (toOsPath f) ReadMode readhandle ) #endif #endif diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs index 4f11f617c9..6fb739b30c 100644 --- a/Annex/Proxy.hs +++ b/Annex/Proxy.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Annex.Proxy where @@ -30,6 +31,7 @@ import Utility.Tmp.Dir import Utility.Metered import Git.Types import qualified Database.Export as Export +import qualified Utility.FileIO as F #ifndef mingw32_HOST_OS import Utility.OpenFile #endif @@ -173,7 +175,7 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go -- independently. Also, this key is not getting added into the -- local annex objects. withproxytmpfile k a = withOtherTmp $ \othertmpdir -> - withTmpDirIn (fromRawFilePath othertmpdir) "proxy" $ \tmpdir -> + withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath "proxy") $ \tmpdir -> a (toRawFilePath tmpdir P. keyFile k) proxyput af k = do @@ -184,7 +186,7 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go -- the client, to avoid bad content -- being stored in the special remote. iv <- startVerifyKeyContentIncrementally Remote.AlwaysVerify k - h <- liftIO $ openFile (fromRawFilePath tmpfile) WriteMode + h <- liftIO $ F.openFile (toOsPath tmpfile) WriteMode let nuketmp = liftIO $ removeWhenExistsWith removeFile (fromRawFilePath tmpfile) gotall <- liftIO $ receivetofile iv h len liftIO $ hClose h diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index 21735eba14..5cb46b17dd 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -1,12 +1,10 @@ {- git-annex file replacing - - - Copyright 2013-2021 Joey Hess + - Copyright 2013-2025 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE CPP #-} - module Annex.ReplaceFile ( replaceGitAnnexDirFile, replaceGitDirFile, @@ -19,24 +17,24 @@ import Annex.Common import Annex.Tmp import Annex.Perms import Git +import Utility.Tmp import Utility.Tmp.Dir import Utility.Directory.Create -#ifndef mingw32_HOST_OS -import Utility.Path.Max -#endif + +import qualified System.FilePath.ByteString as P {- replaceFile on a file located inside the gitAnnexDir. -} -replaceGitAnnexDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a +replaceGitAnnexDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a replaceGitAnnexDirFile = replaceFile createAnnexDirectory {- replaceFile on a file located inside the .git directory. -} -replaceGitDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a +replaceGitDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a replaceGitDirFile = replaceFile $ \dir -> do top <- fromRepo localGitDir liftIO $ createDirectoryUnder [top] dir {- replaceFile on a worktree file. -} -replaceWorkTreeFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a +replaceWorkTreeFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a replaceWorkTreeFile = replaceFile createWorkTreeDirectory {- Replaces a possibly already existing file with a new version, @@ -54,28 +52,17 @@ replaceWorkTreeFile = replaceFile createWorkTreeDirectory - The createdirectory action is only run when moving the file into place - fails, and can create any parent directory structure needed. -} -replaceFile :: (RawFilePath -> Annex ()) -> FilePath -> (RawFilePath -> Annex a) -> Annex a +replaceFile :: (RawFilePath -> Annex ()) -> RawFilePath -> (RawFilePath -> Annex a) -> Annex a replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action -replaceFile' :: (RawFilePath -> Annex ()) -> FilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a +replaceFile' :: (RawFilePath -> Annex ()) -> RawFilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do - let othertmpdir' = fromRawFilePath othertmpdir -#ifndef mingw32_HOST_OS - -- Use part of the filename as the template for the temp - -- directory. This does not need to be unique, but it - -- makes it more clear what this temp directory is for. - filemax <- liftIO $ fileNameLengthLimit othertmpdir' - let basetmp = take (filemax `div` 2) (takeFileName file) -#else - -- Windows has limits on the whole path length, so keep - -- it short. - let basetmp = "t" -#endif - withTmpDirIn othertmpdir' basetmp $ \tmpdir -> do - let tmpfile = toRawFilePath (tmpdir basetmp) + let basetmp = relatedTemplate' (P.takeFileName file) + withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath basetmp) $ \tmpdir -> do + let tmpfile = toRawFilePath tmpdir P. basetmp r <- action tmpfile when (checkres r) $ - replaceFileFrom tmpfile (toRawFilePath file) createdirectory + replaceFileFrom tmpfile file createdirectory return r replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex () diff --git a/Annex/RepoSize/LiveUpdate.hs b/Annex/RepoSize/LiveUpdate.hs index a792b42597..8710282999 100644 --- a/Annex/RepoSize/LiveUpdate.hs +++ b/Annex/RepoSize/LiveUpdate.hs @@ -161,7 +161,7 @@ checkStaleSizeChanges h@(RepoSizeHandle (Just _) livev) = do where go livedir lck pidlockfile now = do void $ tryNonAsync $ do - lockfiles <- liftIO $ filter (not . dirCruft) + lockfiles <- liftIO $ filter (not . dirCruft . toRawFilePath) <$> getDirectoryContents (fromRawFilePath livedir) stale <- forM lockfiles $ \lockfile -> if (lockfile /= pidlockfile) diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 90d462f7be..6cdfba7b02 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -5,6 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Annex.Ssh ( @@ -100,15 +101,16 @@ consumeStdinParams NoConsumeStdin = [Param "-n"] {- Returns a filename to use for a ssh connection caching socket, and - parameters to enable ssh connection caching. -} -sshCachingInfo :: (SshHost, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam]) +sshCachingInfo :: (SshHost, Maybe Integer) -> Annex (Maybe RawFilePath, [CommandParam]) sshCachingInfo (host, port) = go =<< sshCacheDir' where go (Right dir) = liftIO (bestSocketPath $ dir P. hostport2socket host port) >>= return . \case Nothing -> (Nothing, []) Just socketfile -> - let socketfile' = fromRawFilePath socketfile - in (Just socketfile', sshConnectionCachingParams socketfile') + (Just socketfile + , sshConnectionCachingParams (fromRawFilePath socketfile) + ) -- No connection caching with concurrency is not a good -- combination, so warn the user. go (Left whynocaching) = do @@ -214,7 +216,7 @@ portParams (Just port) = [Param "-p", Param $ show port] - Locks the socket lock file to prevent other git-annex processes from - stopping the ssh multiplexer on this socket. -} -prepSocket :: FilePath -> SshHost -> [CommandParam] -> Annex () +prepSocket :: RawFilePath -> SshHost -> [CommandParam] -> Annex () prepSocket socketfile sshhost sshparams = do -- There could be stale ssh connections hanging around -- from a previous git-annex run that was interrupted. @@ -286,13 +288,13 @@ prepSocket socketfile sshhost sshparams = do - and this check makes such files be skipped since the corresponding lock - file won't exist. -} -enumSocketFiles :: Annex [FilePath] +enumSocketFiles :: Annex [RawFilePath] enumSocketFiles = liftIO . go =<< sshCacheDir where go Nothing = return [] go (Just dir) = filterM (R.doesPathExist . socket2lock) =<< filter (not . isLock) - <$> catchDefaultIO [] (dirContents (fromRawFilePath dir)) + <$> catchDefaultIO [] (dirContents dir) {- Stop any unused ssh connection caching processes. -} sshCleanup :: Annex () @@ -324,9 +326,9 @@ sshCleanup = mapM_ cleanup =<< enumSocketFiles forceSshCleanup :: Annex () forceSshCleanup = mapM_ forceStopSsh =<< enumSocketFiles -forceStopSsh :: FilePath -> Annex () +forceStopSsh :: RawFilePath -> Annex () forceStopSsh socketfile = withNullHandle $ \nullh -> do - let (dir, base) = splitFileName socketfile + let (dir, base) = splitFileName (fromRawFilePath socketfile) let p = (proc "ssh" $ toCommand $ [ Param "-O", Param "stop" ] ++ sshConnectionCachingParams base ++ @@ -338,7 +340,7 @@ forceStopSsh socketfile = withNullHandle $ \nullh -> do } void $ liftIO $ catchMaybeIO $ withCreateProcess p $ \_ _ _ pid -> forceSuccessProcess p pid - liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath socketfile) + liftIO $ removeWhenExistsWith R.removeLink socketfile {- This needs to be as short as possible, due to limitations on the length - of the path to a socket file. At the same time, it needs to be unique @@ -355,13 +357,13 @@ hostport2socket' s where lengthofmd5s = 32 -socket2lock :: FilePath -> RawFilePath -socket2lock socket = toRawFilePath (socket ++ lockExt) +socket2lock :: RawFilePath -> RawFilePath +socket2lock socket = socket <> lockExt -isLock :: FilePath -> Bool -isLock f = lockExt `isSuffixOf` f +isLock :: RawFilePath -> Bool +isLock f = lockExt `S.isSuffixOf` f -lockExt :: String +lockExt :: S.ByteString lockExt = ".lock" {- This is the size of the sun_path component of sockaddr_un, which diff --git a/Annex/Tmp.hs b/Annex/Tmp.hs index 2bbebd6388..6f9f28b8b6 100644 --- a/Annex/Tmp.hs +++ b/Annex/Tmp.hs @@ -60,15 +60,17 @@ cleanupOtherTmp = do void $ tryIO $ tryExclusiveLock tmplck $ do tmpdir <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDir void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir - oldtmp <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDirOld + oldtmp <- fromRepo gitAnnexTmpOtherDirOld liftIO $ mapM_ cleanold =<< emptyWhenDoesNotExist (dirContentsRecursive oldtmp) - liftIO $ void $ tryIO $ removeDirectory oldtmp -- when empty + -- remove when empty + liftIO $ void $ tryIO $ + removeDirectory (fromRawFilePath oldtmp) where cleanold f = do now <- liftIO getPOSIXTime let oldenough = now - (60 * 60 * 24 * 7) - catchMaybeIO (modificationTime <$> R.getSymbolicLinkStatus (toRawFilePath f)) >>= \case + catchMaybeIO (modificationTime <$> R.getSymbolicLinkStatus f) >>= \case Just mtime | realToFrac mtime <= oldenough -> - void $ tryIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) + void $ tryIO $ removeWhenExistsWith R.removeLink f _ -> return () diff --git a/Annex/VectorClock.hs b/Annex/VectorClock.hs index db2c63c0bd..792f6e6e82 100644 --- a/Annex/VectorClock.hs +++ b/Annex/VectorClock.hs @@ -21,6 +21,7 @@ import qualified Annex import Utility.TimeStamp import Data.ByteString.Builder +import qualified Data.ByteString as B import qualified Data.Attoparsec.ByteString.Lazy as A currentVectorClock :: Annex CandidateVectorClock @@ -76,7 +77,7 @@ formatVectorClock (VectorClock t) = show t buildVectorClock :: VectorClock -> Builder buildVectorClock = string7 . formatVectorClock -parseVectorClock :: String -> Maybe VectorClock +parseVectorClock :: B.ByteString -> Maybe VectorClock parseVectorClock t = VectorClock <$> parsePOSIXTime t vectorClockParser :: A.Parser VectorClock diff --git a/Annex/VectorClock/Utility.hs b/Annex/VectorClock/Utility.hs index 76b74d9cd5..2c9f40f16e 100644 --- a/Annex/VectorClock/Utility.hs +++ b/Annex/VectorClock/Utility.hs @@ -12,12 +12,13 @@ import Data.Time.Clock.POSIX import Types.VectorClock import Utility.Env import Utility.TimeStamp +import Utility.FileSystemEncoding startVectorClock :: IO (IO CandidateVectorClock) startVectorClock = go =<< getEnv "GIT_ANNEX_VECTOR_CLOCK" where go Nothing = timebased - go (Just s) = case parsePOSIXTime s of + go (Just s) = case parsePOSIXTime (encodeBS s) of Just t -> return (pure (CandidateVectorClock t)) Nothing -> timebased -- Avoid using fractional seconds in the CandidateVectorClock. diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs index 3a4dd051bc..6544f3d1f5 100644 --- a/Annex/YoutubeDl.hs +++ b/Annex/YoutubeDl.hs @@ -30,6 +30,8 @@ import Utility.Metered import Utility.Tmp import Messages.Progress import Logs.Transfer +import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import Network.URI import Control.Concurrent.Async @@ -37,7 +39,6 @@ import Text.Read import Data.Either import qualified Data.Aeson as Aeson import GHC.Generics -import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 -- youtube-dl can follow redirects to anywhere, including potentially @@ -101,9 +102,9 @@ youtubeDl' url workdir p uo | isytdlp cmd = liftIO $ (nub . lines <$> readFile filelistfile) `catchIO` (pure . const []) - | otherwise = workdirfiles - workdirfiles = liftIO $ filter (/= filelistfile) - <$> (filterM (doesFileExist) =<< dirContents workdir) + | otherwise = map fromRawFilePath <$> workdirfiles + workdirfiles = liftIO $ filter (/= toRawFilePath filelistfile) + <$> (filterM R.doesPathExist =<< dirContents (toRawFilePath workdir)) filelistfile = workdir filelistfilebase filelistfilebase = "git-annex-file-list-file" isytdlp cmd = cmd == "yt-dlp" @@ -159,7 +160,7 @@ youtubeDlMaxSize workdir = ifM (Annex.getRead Annex.force) Just have -> do inprogress <- sizeOfDownloadsInProgress (const True) partial <- liftIO $ sum - <$> (mapM (getFileSize . toRawFilePath) =<< dirContents workdir) + <$> (mapM getFileSize =<< dirContents (toRawFilePath workdir)) reserve <- annexDiskReserve <$> Annex.getGitConfig let maxsize = have - reserve - inprogress + partial if maxsize > 0 @@ -352,7 +353,7 @@ youtubePlaylist url = do else return $ Left $ "Scraping needs yt-dlp, but git-annex has been configured to use " ++ cmd youtubePlaylist' :: URLString -> String -> IO (Either String [YoutubePlaylistItem]) -youtubePlaylist' url cmd = withTmpFile "yt-dlp" $ \tmpfile h -> do +youtubePlaylist' url cmd = withTmpFile (toOsPath (toRawFilePath "yt-dlp")) $ \tmpfile h -> do hClose h (outerr, ok) <- processTranscript cmd [ "--simulate" @@ -362,14 +363,14 @@ youtubePlaylist' url cmd = withTmpFile "yt-dlp" $ \tmpfile h -> do , "--print-to-file" -- Write json with selected fields. , "%(.{" ++ intercalate "," youtubePlaylistItemFields ++ "})j" - , tmpfile + , fromRawFilePath (fromOsPath tmpfile) , url ] Nothing if ok then flip catchIO (pure . Left . show) $ do v <- map Aeson.eitherDecodeStrict . B8.lines - <$> B.readFile tmpfile + <$> F.readFile' tmpfile return $ case partitionEithers v of ((parserr:_), _) -> Left $ "yt-dlp json parse error: " ++ parserr diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 68edd95c47..eeb40605ea 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -22,6 +22,7 @@ import qualified Remote import qualified Types.Remote as Remote import Config.DynamicConfig import Annex.SpecialRemote.Config +import qualified Utility.FileIO as F import Control.Concurrent.STM import System.Posix.Types @@ -121,9 +122,9 @@ startDaemonStatus = do - and parts of it are not relevant. -} writeDaemonStatusFile :: FilePath -> DaemonStatus -> IO () writeDaemonStatusFile file status = - viaTmp writeFile file =<< serialized <$> getPOSIXTime + viaTmp F.writeFile' (toOsPath (toRawFilePath file)) =<< serialized <$> getPOSIXTime where - serialized now = unlines + serialized now = encodeBS $ unlines [ "lastRunning:" ++ show now , "scanComplete:" ++ show (scanComplete status) , "sanityCheckRunning:" ++ show (sanityCheckRunning status) @@ -135,13 +136,13 @@ readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFile file where parse status = foldr parseline status . lines parseline line status - | key == "lastRunning" = parseval parsePOSIXTime $ \v -> + | key == "lastRunning" = parseval (parsePOSIXTime . encodeBS) $ \v -> status { lastRunning = Just v } | key == "scanComplete" = parseval readish $ \v -> status { scanComplete = v } | key == "sanityCheckRunning" = parseval readish $ \v -> status { sanityCheckRunning = v } - | key == "lastSanityCheck" = parseval parsePOSIXTime $ \v -> + | key == "lastSanityCheck" = parseval (parsePOSIXTime . encodeBS) $ \v -> status { lastSanityCheck = Just v } | otherwise = status -- unparsable line where diff --git a/Assistant/Install.hs b/Assistant/Install.hs index c11b6d5585..db34000672 100644 --- a/Assistant/Install.hs +++ b/Assistant/Install.hs @@ -17,6 +17,7 @@ import Utility.Shell import Utility.Tmp import Utility.Env import Utility.SshConfig +import qualified Utility.FileIO as F #ifdef darwin_HOST_OS import Utility.OSX @@ -28,6 +29,7 @@ import Utility.Android #endif import System.PosixCompat.Files (ownerExecuteMode) +import qualified Data.ByteString.Char8 as S8 standaloneAppBase :: IO (Maybe FilePath) standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE" @@ -82,7 +84,7 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL") let runshell var = "exec " ++ base "runshell " ++ var let rungitannexshell var = runshell $ "git-annex-shell -c \"" ++ var ++ "\"" - installWrapper (sshdir "git-annex-shell") $ unlines + installWrapper (toRawFilePath (sshdir "git-annex-shell")) $ [ shebang , "set -e" , "if [ \"x$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then" @@ -91,7 +93,7 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL") , rungitannexshell "$@" , "fi" ] - installWrapper (sshdir "git-annex-wrapper") $ unlines + installWrapper (toRawFilePath (sshdir "git-annex-wrapper")) $ [ shebang , "set -e" , runshell "\"$@\"" @@ -99,14 +101,15 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL") installFileManagerHooks program -installWrapper :: FilePath -> String -> IO () +installWrapper :: RawFilePath -> [String] -> IO () installWrapper file content = do - curr <- catchDefaultIO "" $ readFileStrict file - when (curr /= content) $ do - createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath file))) - viaTmp writeFile file content - modifyFileMode (toRawFilePath file) $ - addModes [ownerExecuteMode] + let content' = map encodeBS content + curr <- catchDefaultIO [] $ fileLines' <$> F.readFile' (toOsPath file) + when (curr /= content') $ do + createDirectoryIfMissing True (fromRawFilePath (parentDir file)) + viaTmp F.writeFile' (toOsPath file) $ + linesFile' (S8.unlines content') + modifyFileMode file $ addModes [ownerExecuteMode] installFileManagerHooks :: FilePath -> IO () #ifdef linux_HOST_OS @@ -127,17 +130,18 @@ installFileManagerHooks program = unlessM osAndroid $ do (kdeDesktopFile actions) where genNautilusScript scriptdir action = - installscript (scriptdir scriptname action) $ unlines + installscript (toRawFilePath (scriptdir scriptname action)) $ unlines [ shebang , autoaddedcomment , "exec " ++ program ++ " " ++ action ++ " --notify-start --notify-finish -- \"$@\"" ] scriptname action = "git-annex " ++ action installscript f c = whenM (safetoinstallscript f) $ do - writeFile f c - modifyFileMode (toRawFilePath f) $ addModes [ownerExecuteMode] + writeFile (fromRawFilePath f) c + modifyFileMode f $ addModes [ownerExecuteMode] safetoinstallscript f = catchDefaultIO True $ - elem autoaddedcomment . lines <$> readFileStrict f + elem (encodeBS autoaddedcomment) . fileLines' + <$> F.readFile' (toOsPath f) autoaddedcomment = "# " ++ autoaddedmsg ++ " (To disable, chmod 600 this file.)" autoaddedmsg = "Automatically added by git-annex, do not edit." diff --git a/Assistant/Repair.hs b/Assistant/Repair.hs index 02ebab3cae..4c37227c8d 100644 --- a/Assistant/Repair.hs +++ b/Assistant/Repair.hs @@ -5,6 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Assistant.Repair where @@ -33,6 +34,8 @@ import Utility.ThreadScheduler import qualified Utility.RawFilePath as R import Control.Concurrent.Async +import qualified Data.ByteString as S +import qualified System.FilePath.ByteString as P {- When the FsckResults require a repair, tries to do a non-destructive - repair. If that fails, pops up an alert. -} @@ -132,26 +135,26 @@ repairStaleGitLocks r = do repairStaleLocks lockfiles return $ not $ null lockfiles where - findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator (fromRawFilePath annexDir)) True . fromRawFilePath . Git.localGitDir + findgitfiles = dirContentsRecursiveSkipping (== P.dropTrailingPathSeparator annexDir) True . Git.localGitDir islock f - | "gc.pid" `isInfixOf` f = False - | ".lock" `isSuffixOf` f = True - | takeFileName f == "MERGE_HEAD" = True + | "gc.pid" `S.isInfixOf` f = False + | ".lock" `S.isSuffixOf` f = True + | P.takeFileName f == "MERGE_HEAD" = True | otherwise = False -repairStaleLocks :: [FilePath] -> Assistant () +repairStaleLocks :: [RawFilePath] -> Assistant () repairStaleLocks lockfiles = go =<< getsizes where getsize lf = catchMaybeIO $ (\s -> (lf, s)) - <$> getFileSize (toRawFilePath lf) + <$> getFileSize lf getsizes = liftIO $ catMaybes <$> mapM getsize lockfiles go [] = return () - go l = ifM (liftIO $ null <$> Lsof.query ("--" : map fst l)) + go l = ifM (liftIO $ null <$> Lsof.query ("--" : map (fromRawFilePath . fst) l)) ( do waitforit "to check stale git lock file" l' <- getsizes if l' == l - then liftIO $ mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath . fst) l + then liftIO $ mapM_ (removeWhenExistsWith R.removeLink . fst) l else go l' , do waitforit "for git lock file writer" diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 3f472a5332..3a9235c76d 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -17,6 +17,7 @@ import Utility.SshConfig import Git.Remote import Utility.SshHost import Utility.Process.Transcript +import qualified Utility.FileIO as F import Data.Text (Text) import qualified Data.Text as T @@ -158,8 +159,8 @@ removeAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO () removeAuthorizedKeys gitannexshellonly dir pubkey = do let keyline = authorizedKeysLine gitannexshellonly dir pubkey sshdir <- sshDir - let keyfile = sshdir "authorized_keys" - tryWhenExists (lines <$> readFileStrict keyfile) >>= \case + let keyfile = toOsPath $ toRawFilePath $ sshdir "authorized_keys" + tryWhenExists (map decodeBS . fileLines' <$> F.readFile' keyfile) >>= \case Just ls -> viaTmp writeSshConfig keyfile $ unlines $ filter (/= keyline) ls Nothing -> noop @@ -212,7 +213,7 @@ authorizedKeysLine gitannexshellonly dir pubkey {- Generates a ssh key pair. -} genSshKeyPair :: IO SshKeyPair -genSshKeyPair = withTmpDir "git-annex-keygen" $ \dir -> do +genSshKeyPair = withTmpDir (toOsPath (toRawFilePath "git-annex-keygen")) $ \dir -> do ok <- boolSystem "ssh-keygen" [ Param "-P", Param "" -- no password , Param "-f", File $ dir "key" diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs index 067bd0b022..f5e9cff7da 100644 --- a/Assistant/Threads/TransferPoller.hs +++ b/Assistant/Threads/TransferPoller.hs @@ -47,7 +47,7 @@ transferPollerThread = namedThread "TransferPoller" $ do | otherwise = do let (f, _, _) = transferFileAndLockFile t g mi <- liftIO $ catchDefaultIO Nothing $ - readTransferInfoFile Nothing (fromRawFilePath f) + readTransferInfoFile Nothing f maybe noop (newsize t info . bytesComplete) mi newsize t info sz diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index d692a3ffd0..bff9263fb6 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -57,7 +57,7 @@ onErr = giveup {- Called when a new transfer information file is written. -} onAdd :: Handler -onAdd file = case parseTransferFile file of +onAdd file = case parseTransferFile (toRawFilePath file) of Nothing -> noop Just t -> go t =<< liftAnnex (checkTransfer t) where @@ -73,9 +73,9 @@ onAdd file = case parseTransferFile file of - The only thing that should change in the transfer info is the - bytesComplete, so that's the only thing updated in the DaemonStatus. -} onModify :: Handler -onModify file = case parseTransferFile file of +onModify file = case parseTransferFile (toRawFilePath file) of Nothing -> noop - Just t -> go t =<< liftIO (readTransferInfoFile Nothing file) + Just t -> go t =<< liftIO (readTransferInfoFile Nothing (toRawFilePath file)) where go _ Nothing = noop go t (Just newinfo) = alterTransferInfo t $ @@ -88,7 +88,7 @@ watchesTransferSize = modifyTracked {- Called when a transfer information file is removed. -} onDel :: Handler -onDel file = case parseTransferFile file of +onDel file = case parseTransferFile (toRawFilePath file) of Nothing -> noop Just t -> do debug [ "transfer finishing:", show t] diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 04c5f97b25..37ac9b876e 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -289,7 +289,7 @@ onAddSymlink' linktarget mk file filestatus = go mk if linktarget == Just link then ensurestaged (Just link) =<< getDaemonStatus else do - liftAnnex $ replaceWorkTreeFile file $ + liftAnnex $ replaceWorkTreeFile (toRawFilePath file) $ makeAnnexLink link addLink file link (Just key) -- other symlink, not git-annex diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index 3fdd12d05f..ad7cd13d47 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -89,9 +89,9 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost , return app ) runWebApp tlssettings listenhost' listenport' app' $ \addr -> if noannex - then withTmpFile "webapp.html" $ \tmpfile h -> do + then withTmpFile (toOsPath "webapp.html") $ \tmpfile h -> do hClose h - go tlssettings addr webapp tmpfile Nothing + go tlssettings addr webapp (fromRawFilePath (fromOsPath tmpfile)) Nothing else do htmlshim <- getAnnex' $ fromRepo gitAnnexHtmlShim urlfile <- getAnnex' $ fromRepo gitAnnexUrlFile diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index 81d7f70b23..1440af10d0 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -41,9 +41,11 @@ import qualified Utility.Url as Url import qualified Annex.Url as Url hiding (download) import Utility.Tuple import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import Data.Either import qualified Data.Map as M +import qualified System.FilePath.ByteString as P {- Upgrade without interaction in the webapp. -} unattendedUpgrade :: Assistant () @@ -163,7 +165,7 @@ upgradeToDistribution newdir cleanup distributionfile = do {- OS X uses a dmg, so mount it, and copy the contents into place. -} unpack = liftIO $ do olddir <- oldVersionLocation - withTmpDirIn (fromRawFilePath (parentDir (toRawFilePath newdir))) "git-annex.upgrade" $ \tmpdir -> do + withTmpDirIn (fromRawFilePath (parentDir (toRawFilePath newdir))) (toOsPath (toRawFilePath "git-annex.upgrade")) $ \tmpdir -> do void $ boolSystem "hdiutil" [ Param "attach", File distributionfile , Param "-mountpoint", File tmpdir @@ -188,7 +190,7 @@ upgradeToDistribution newdir cleanup distributionfile = do - into place. -} unpack = liftIO $ do olddir <- oldVersionLocation - withTmpDirIn (fromRawFilePath $ parentDir $ toRawFilePath newdir) "git-annex.upgrade" $ \tmpdir -> do + withTmpDirIn (fromRawFilePath $ parentDir $ toRawFilePath newdir) (toOsPath $ toRawFilePath "git-annex.upgrade") $ \tmpdir -> do let tarball = tmpdir "tar" -- Cannot rely on filename extension, and this also -- avoids problems if tar doesn't support transparent @@ -212,8 +214,8 @@ upgradeToDistribution newdir cleanup distributionfile = do makeorigsymlink olddir return (newdir "git-annex", deleteold) installby a dstdir srcdir = - mapM_ (\x -> a (toRawFilePath x) (toRawFilePath (dstdir takeFileName x))) - =<< dirContents srcdir + mapM_ (\x -> a x (toRawFilePath dstdir P. P.takeFileName x)) + =<< dirContents (toRawFilePath srcdir) #endif sanitycheck dir = unlessM (doesDirectoryExist dir) $ @@ -280,14 +282,14 @@ deleteFromManifest dir = do fs <- map (dir ) . lines <$> catchDefaultIO "" (readFile manifest) mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath) fs removeWhenExistsWith R.removeLink (toRawFilePath manifest) - removeEmptyRecursive dir + removeEmptyRecursive (toRawFilePath dir) where manifest = dir "git-annex.MANIFEST" -removeEmptyRecursive :: FilePath -> IO () +removeEmptyRecursive :: RawFilePath -> IO () removeEmptyRecursive dir = do mapM_ removeEmptyRecursive =<< dirContents dir - void $ tryIO $ removeDirectory dir + void $ tryIO $ removeDirectory (fromRawFilePath dir) {- This is a file that the UpgradeWatcher can watch for modifications to - detect when git-annex has been upgraded. @@ -322,13 +324,14 @@ downloadDistributionInfo :: Assistant (Maybe GitAnnexDistribution) downloadDistributionInfo = do uo <- liftAnnex Url.getUrlOptions gpgcmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig - liftIO $ withTmpDir "git-annex.tmp" $ \tmpdir -> do + liftIO $ withTmpDir (toOsPath (toRawFilePath "git-annex.tmp")) $ \tmpdir -> do let infof = tmpdir "info" let sigf = infof ++ ".sig" ifM (isRight <$> Url.download nullMeterUpdate Nothing distributionInfoUrl infof uo <&&> (isRight <$> Url.download nullMeterUpdate Nothing distributionInfoSigUrl sigf uo) <&&> verifyDistributionSig gpgcmd sigf) - ( parseInfoFile <$> readFileStrict infof + ( parseInfoFile . map decodeBS . fileLines' + <$> F.readFile' (toOsPath (toRawFilePath infof)) , return Nothing ) @@ -360,7 +363,7 @@ upgradeSupported = False verifyDistributionSig :: GpgCmd -> FilePath -> IO Bool verifyDistributionSig gpgcmd sig = readProgramFile >>= \case Just p | isAbsolute p -> - withUmask 0o0077 $ withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do + withUmask 0o0077 $ withTmpDir (toOsPath (toRawFilePath "git-annex-gpg.tmp")) $ \gpgtmp -> do let trustedkeys = takeDirectory p "trustedkeys.gpg" boolGpgCmd gpgcmd [ Param "--no-default-keyring" diff --git a/Assistant/WebApp/Configurators/Delete.hs b/Assistant/WebApp/Configurators/Delete.hs index 333e13656a..31b5b19d14 100644 --- a/Assistant/WebApp/Configurators/Delete.hs +++ b/Assistant/WebApp/Configurators/Delete.hs @@ -89,7 +89,7 @@ deleteCurrentRepository = dangerPage $ do rs <- syncRemotes <$> getDaemonStatus mapM_ (\r -> changeSyncable (Just r) False) rs - liftAnnex $ prepareRemoveAnnexDir dir + liftAnnex $ prepareRemoveAnnexDir (toRawFilePath dir) liftIO $ removeDirectoryRecursive . fromRawFilePath =<< absPath (toRawFilePath dir) diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs index 04ac8ceb1d..4edfee9fca 100644 --- a/Assistant/WebApp/Configurators/Ssh.hs +++ b/Assistant/WebApp/Configurators/Ssh.hs @@ -389,13 +389,13 @@ sshAuthTranscript sshinput opts sshhost cmd input = case inputAuthMethod sshinpu v <- getCachedCred login liftIO $ case v of Nothing -> go [passwordprompts 0] Nothing - Just pass -> withTmpFile "ssh" $ \passfile h -> do + Just pass -> withTmpFile (toOsPath "ssh") $ \passfile h -> do hClose h - writeFileProtected (toRawFilePath passfile) pass + writeFileProtected (fromOsPath passfile) pass environ <- getEnvironment let environ' = addEntries [ ("SSH_ASKPASS", program) - , (sshAskPassEnv, passfile) + , (sshAskPassEnv, fromRawFilePath $ fromOsPath passfile) , ("DISPLAY", ":0") ] environ go [passwordprompts 1] (Just environ') diff --git a/Backend/Utilities.hs b/Backend/Utilities.hs index 304cfaac16..244ded29e5 100644 --- a/Backend/Utilities.hs +++ b/Backend/Utilities.hs @@ -29,12 +29,12 @@ import Data.Word genKeyName :: String -> S.ShortByteString genKeyName s -- Avoid making keys longer than the length of a SHA256 checksum. - | bytelen > sha256len = S.toShort $ encodeBS $ - truncateFilePath (sha256len - md5len - 1) s' ++ "-" ++ - show (md5 bl) - | otherwise = S.toShort $ encodeBS s' + | bytelen > sha256len = S.toShort $ + truncateFilePath (sha256len - md5len - 1) s' + <> "-" <> encodeBS (show (md5 bl)) + | otherwise = S.toShort s' where - s' = preSanitizeKeyName s + s' = encodeBS $ preSanitizeKeyName s bl = encodeBL s bytelen = fromIntegral $ L.length bl diff --git a/Build/LinuxMkLibs.hs b/Build/LinuxMkLibs.hs index 6a5f8dea01..fad73c4c76 100644 --- a/Build/LinuxMkLibs.hs +++ b/Build/LinuxMkLibs.hs @@ -26,11 +26,12 @@ import Utility.Path.AbsRel import Utility.FileMode import Utility.CopyFile import Utility.FileSystemEncoding +import Utility.SystemDirectory mklibs :: FilePath -> a -> IO Bool mklibs top _installedbins = do - fs <- dirContentsRecursive top - exes <- filterM checkExe fs + fs <- dirContentsRecursive (toRawFilePath top) + exes <- filterM checkExe (map fromRawFilePath fs) libs <- runLdd exes glibclibs <- glibcLibs @@ -80,7 +81,7 @@ consolidateUsrLib top libdirs = go [] libdirs forM_ fs $ \f -> do let src = inTop top (x f) let dst = inTop top (d f) - unless (dirCruft f) $ + unless (dirCruft (toRawFilePath f)) $ unlessM (doesDirectoryExist src) $ renameFile src dst symlinkHwCapDirs top d diff --git a/Build/Standalone.hs b/Build/Standalone.hs index 367527430a..36a4d5a002 100644 --- a/Build/Standalone.hs +++ b/Build/Standalone.hs @@ -25,6 +25,7 @@ import Utility.Path.AbsRel import Utility.Directory import Utility.Env import Utility.FileSystemEncoding +import Utility.SystemDirectory import Build.BundledPrograms #ifdef darwin_HOST_OS import System.IO @@ -71,14 +72,15 @@ installGitLibs topdir = do -- install git-core programs; these are run by the git command createDirectoryIfMissing True gitcoredestdir execpath <- getgitpath "exec-path" - cfs <- dirContents execpath + cfs <- dirContents (toRawFilePath execpath) forM_ cfs $ \f -> do + let f' = fromRawFilePath f destf <- ((gitcoredestdir ) . fromRawFilePath) <$> relPathDirToFile (toRawFilePath execpath) - (toRawFilePath f) + f createDirectoryIfMissing True (takeDirectory destf) - issymlink <- isSymbolicLink <$> getSymbolicLinkStatus f + issymlink <- isSymbolicLink <$> getSymbolicLinkStatus f' if issymlink then do -- many git-core files may symlink to eg @@ -91,20 +93,20 @@ installGitLibs topdir = do -- Other git-core files symlink to a file -- beside them in the directory. Those -- links can be copied as-is. - linktarget <- readSymbolicLink f + linktarget <- readSymbolicLink f' if takeFileName linktarget == linktarget - then cp f destf + then cp f' destf else do let linktarget' = progDir topdir takeFileName linktarget unlessM (doesFileExist linktarget') $ do createDirectoryIfMissing True (takeDirectory linktarget') - L.readFile f >>= L.writeFile linktarget' + L.readFile f' >>= L.writeFile linktarget' removeWhenExistsWith removeLink destf rellinktarget <- relPathDirToFile (toRawFilePath (takeDirectory destf)) (toRawFilePath linktarget') createSymbolicLink (fromRawFilePath rellinktarget) destf - else cp f destf + else cp f' destf -- install git's template files -- git does not have an option to get the path of these, @@ -112,14 +114,14 @@ installGitLibs topdir = do -- next to the --man-path, in eg /usr/share/git-core manpath <- getgitpath "man-path" let templatepath = manpath ".." "git-core" "templates" - tfs <- dirContents templatepath + tfs <- dirContents (toRawFilePath templatepath) forM_ tfs $ \f -> do destf <- ((templatedestdir ) . fromRawFilePath) <$> relPathDirToFile (toRawFilePath templatepath) - (toRawFilePath f) + f createDirectoryIfMissing True (takeDirectory destf) - cp f destf + cp (fromRawFilePath f) destf where gitcoredestdir = topdir "git-core" templatedestdir = topdir "templates" diff --git a/Build/Version.hs b/Build/Version.hs index 0d95dc7b26..e3b905919d 100644 --- a/Build/Version.hs +++ b/Build/Version.hs @@ -1,6 +1,6 @@ {- Package version determination. -} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-} module Build.Version where @@ -14,7 +14,9 @@ import Prelude import Utility.Monad import Utility.Exception -import Utility.Misc +import Utility.OsPath +import Utility.FileSystemEncoding +import qualified Utility.FileIO as F type Version = String @@ -56,11 +58,11 @@ getChangelogVersion = do middle = drop 1 . init writeVersion :: Version -> IO () -writeVersion ver = catchMaybeIO (readFileStrict f) >>= \case +writeVersion ver = catchMaybeIO (F.readFile' f) >>= \case Just s | s == body -> return () - _ -> writeFile f body + _ -> F.writeFile' f body where - body = unlines $ concat + body = encodeBS $ unlines $ concat [ header , ["packageversion :: String"] , ["packageversion = \"" ++ ver ++ "\""] @@ -71,4 +73,4 @@ writeVersion ver = catchMaybeIO (readFileStrict f) >>= \case , "" ] footer = [] - f = "Build/Version" + f = toOsPath "Build/Version" diff --git a/CHANGELOG b/CHANGELOG index fa11259b2b..f720bf9850 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -3,6 +3,7 @@ git-annex (10.20250116) UNRELEASED; urgency=medium * Support help.autocorrect settings "prompt", "never", and "immediate". * Allow setting remote.foo.annex-tracking-branch to a branch name that contains "/", as long as it's not a remote tracking branch. + * Added OsPath build flag, which speeds up git-annex's operations on files. -- Joey Hess Mon, 20 Jan 2025 10:24:51 -0400 diff --git a/CmdLine/GitRemoteAnnex.hs b/CmdLine/GitRemoteAnnex.hs index da2a61b34b..91bdc0b263 100644 --- a/CmdLine/GitRemoteAnnex.hs +++ b/CmdLine/GitRemoteAnnex.hs @@ -57,6 +57,8 @@ import Utility.Tmp.Dir import Utility.Env import Utility.Metered import Utility.FileMode +import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import Network.URI import Data.Either @@ -65,7 +67,6 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.Map.Strict as M import qualified System.FilePath.ByteString as P -import qualified Utility.RawFilePath as R import qualified Data.Set as S run :: [String] -> IO () @@ -495,13 +496,16 @@ resolveSpecialRemoteWebUrl :: String -> Annex (Maybe String) resolveSpecialRemoteWebUrl url | "http://" `isPrefixOf` lcurl || "https://" `isPrefixOf` lcurl = Url.withUrlOptionsPromptingCreds $ \uo -> - withTmpFile "git-remote-annex" $ \tmp h -> do + withTmpFile (toOsPath "git-remote-annex") $ \tmp h -> do liftIO $ hClose h - Url.download' nullMeterUpdate Nothing url tmp uo >>= \case + let tmp' = fromRawFilePath $ fromOsPath tmp + Url.download' nullMeterUpdate Nothing url tmp' uo >>= \case Left err -> giveup $ url ++ " " ++ err Right () -> liftIO $ - (headMaybe . lines) - <$> readFileStrict tmp + fmap decodeBS + . headMaybe + . fileLines' + <$> F.readFile' tmp | otherwise = return Nothing where lcurl = map toLower url @@ -724,10 +728,10 @@ downloadManifest rmt = get mkmain >>= maybe (get mkbak) (pure . Just) -- it needs to re-download it fresh every time, and the object -- file should not be stored locally. gettotmp dl = withOtherTmp $ \othertmp -> - withTmpFileIn (fromRawFilePath othertmp) "GITMANIFEST" $ \tmp tmph -> do + withTmpFileIn (toOsPath othertmp) (toOsPath "GITMANIFEST") $ \tmp tmph -> do liftIO $ hClose tmph - _ <- dl tmp - b <- liftIO (B.readFile tmp) + _ <- dl (fromRawFilePath (fromOsPath tmp)) + b <- liftIO (F.readFile' tmp) case parseManifest b of Right m -> Just <$> verifyManifest rmt m Left err -> giveup err @@ -774,7 +778,7 @@ uploadManifest rmt manifest = do dropKey' rmt mk put mk - put mk = withTmpFile "GITMANIFEST" $ \tmp tmph -> do + put mk = withTmpFile (toOsPath "GITMANIFEST") $ \tmp tmph -> do liftIO $ B8.hPut tmph (formatManifest manifest) liftIO $ hClose tmph -- Uploading needs the key to be in the annex objects @@ -785,7 +789,7 @@ uploadManifest rmt manifest = do -- keys, which it is not. objfile <- calcRepo (gitAnnexLocation mk) modifyContentDir objfile $ - linkOrCopy mk (toRawFilePath tmp) objfile Nothing >>= \case + linkOrCopy mk (fromOsPath tmp) objfile Nothing >>= \case -- Important to set the right perms even -- though the object is only present -- briefly, since sending objects may rely @@ -857,7 +861,7 @@ startPush' rmt manifest = do f <- fromRepo (lastPushedManifestFile (Remote.uuid rmt)) oldmanifest <- liftIO $ fromRight mempty . parseManifest - <$> B.readFile (fromRawFilePath f) + <$> F.readFile' (toOsPath f) `catchNonAsync` (const (pure mempty)) let oldmanifest' = mkManifest [] $ S.fromList (inManifest oldmanifest) @@ -973,14 +977,15 @@ generateGitBundle -> Manifest -> Annex (Key, Annex ()) generateGitBundle rmt bs manifest = - withTmpFile "GITBUNDLE" $ \tmp tmph -> do + withTmpFile (toOsPath "GITBUNDLE") $ \tmp tmph -> do + let tmp' = fromOsPath tmp liftIO $ hClose tmph - inRepo $ Git.Bundle.create tmp bs + inRepo $ Git.Bundle.create (fromRawFilePath tmp') bs bundlekey <- genGitBundleKey (Remote.uuid rmt) - (toRawFilePath tmp) nullMeterUpdate + tmp' nullMeterUpdate if (bundlekey `notElem` inManifest manifest) then do - unlessM (moveAnnex bundlekey (AssociatedFile Nothing) (toRawFilePath tmp)) $ + unlessM (moveAnnex bundlekey (AssociatedFile Nothing) tmp') $ giveup "Unable to push" return (bundlekey, uploadaction bundlekey) else return (bundlekey, noop) @@ -1122,7 +1127,7 @@ startAnnexBranch = ifM (null <$> Annex.Branch.siblingBranches) -- journal writes to a temporary directory, so that all writes -- to the git-annex branch by the action will be discarded. specialRemoteFromUrl :: StartAnnexBranch -> Annex a -> Annex a -specialRemoteFromUrl sab a = withTmpDir "journal" $ \tmpdir -> do +specialRemoteFromUrl sab a = withTmpDir (toOsPath "journal") $ \tmpdir -> do Annex.overrideGitConfig $ \c -> c { annexAlwaysCommit = False } Annex.BranchState.changeState $ \st -> @@ -1162,7 +1167,8 @@ specialRemoteFromUrl sab a = withTmpDir "journal" $ \tmpdir -> do -- objects are deleted. cleanupInitialization :: StartAnnexBranch -> FilePath -> Annex () cleanupInitialization sab alternatejournaldir = void $ tryNonAsync $ do - liftIO $ mapM_ removeFile =<< dirContents alternatejournaldir + liftIO $ mapM_ R.removeLink + =<< dirContents (toRawFilePath alternatejournaldir) case sab of AnnexBranchExistedAlready _ -> noop AnnexBranchCreatedEmpty r -> diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index 07818dcda5..a25c6b083b 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -56,6 +56,7 @@ import Data.IORef import Data.Time.Clock.POSIX import System.PosixCompat.Files (isDirectory, isSymbolicLink, deviceID, fileID) import qualified System.FilePath.ByteString as P +import qualified Data.ByteString as S data AnnexedFileSeeker = AnnexedFileSeeker { startAction :: Maybe KeySha -> SeekInput -> RawFilePath -> Key -> CommandStart @@ -122,9 +123,8 @@ withPathContents a params = do -- exist. get p = ifM (isDirectory <$> R.getFileStatus p') ( map (\f -> - let f' = toRawFilePath f - in (f', P.makeRelative (P.takeDirectory (P.dropTrailingPathSeparator p')) f')) - <$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) False p + (f, P.makeRelative (P.takeDirectory (P.dropTrailingPathSeparator p')) f)) + <$> dirContentsRecursiveSkipping (".git" `S.isSuffixOf`) False p' , return [(p', P.takeFileName p')] ) where diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 7feb0b19eb..d464dbd048 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -200,12 +200,12 @@ checkUrl addunlockedmatcher r o si u = do startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart startRemote addunlockedmatcher r o si file uri sz = do pathmax <- liftIO $ fileNameLengthLimit "." - let file' = joinPath $ map (truncateFilePath pathmax) $ - splitDirectories file + let file' = P.joinPath $ map (truncateFilePath pathmax) $ + P.splitDirectories (toRawFilePath file) startingAddUrl si uri o $ do showNote $ UnquotedString $ "from " ++ Remote.name r - showDestinationFile (toRawFilePath file') - performRemote addunlockedmatcher r o uri (toRawFilePath file') sz + showDestinationFile file' + performRemote addunlockedmatcher r o uri file' sz performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> RawFilePath -> Maybe Integer -> CommandPerform performRemote addunlockedmatcher r o uri file sz = lookupKey file >>= \case @@ -279,7 +279,8 @@ sanitizeOrPreserveFilePath o f return f | otherwise = do pathmax <- liftIO $ fileNameLengthLimit "." - return $ truncateFilePath pathmax $ sanitizeFilePath f + return $ fromRawFilePath $ truncateFilePath pathmax $ + toRawFilePath $ sanitizeFilePath f -- sanitizeFilePath avoids all these security problems -- (and probably others, but at least this catches the most egrarious ones). @@ -353,7 +354,7 @@ downloadWeb addunlockedmatcher o url urlinfo file = urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing (verifiableOption o) downloader f p = Url.withUrlOptions $ downloadUrl False urlkey p Nothing [url] f go Nothing = return Nothing - go (Just (tmp, backend)) = ifM (useYoutubeDl o <&&> liftIO (isHtmlFile (fromRawFilePath tmp))) + go (Just (tmp, backend)) = ifM (useYoutubeDl o <&&> liftIO (isHtmlFile tmp)) ( tryyoutubedl tmp backend , normalfinish tmp backend ) @@ -567,8 +568,8 @@ nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ \canadd url2file :: URI -> Maybe Int -> Int -> FilePath url2file url pathdepth pathmax = case pathdepth of - Nothing -> truncateFilePath pathmax $ sanitizeFilePath fullurl - Just depth + Nothing -> truncatesanitize fullurl + Just depth | depth >= length urlbits -> frombits id | depth > 0 -> frombits $ drop depth | depth < 0 -> frombits $ reverse . take (negate depth) . reverse @@ -580,8 +581,12 @@ url2file url pathdepth pathmax = case pathdepth of , uriQuery url ] frombits a = intercalate "/" $ a urlbits - urlbits = map (truncateFilePath pathmax . sanitizeFilePath) $ + urlbits = map truncatesanitize $ filter (not . null) $ splitc '/' fullurl + truncatesanitize = fromRawFilePath + . truncateFilePath pathmax + . toRawFilePath + . sanitizeFilePath urlString2file :: URLString -> Maybe Int -> Int -> FilePath urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of diff --git a/Command/Export.hs b/Command/Export.hs index 4e87323bf3..a8bdfab5ab 100644 --- a/Command/Export.hs +++ b/Command/Export.hs @@ -312,12 +312,12 @@ performExport r srcrs db ek af contentsha loc allfilledvar = do sent <- tryNonAsync $ if not (isGitShaKey ek) then tryrenameannexobject $ sendannexobject -- Sending a non-annexed file. - else withTmpFile "export" $ \tmp h -> do + else withTmpFile (toOsPath "export") $ \tmp h -> do b <- catObject contentsha liftIO $ L.hPut h b liftIO $ hClose h Remote.action $ - storer tmp ek loc nullMeterUpdate + storer (fromRawFilePath (fromOsPath tmp)) ek loc nullMeterUpdate let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False)) case sent of Right True -> next $ cleanupExport r db ek loc True diff --git a/Command/Fix.hs b/Command/Fix.hs index 862853a861..eb8f6383e3 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -72,7 +72,7 @@ start fixwhat si file key = do breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform breakHardLink file key obj = do - replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do + replaceWorkTreeFile file $ \tmp -> do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file unlessM (checkedCopyFile key obj tmp mode) $ giveup "unable to break hard link" @@ -83,7 +83,7 @@ breakHardLink file key obj = do makeHardLink :: RawFilePath -> Key -> CommandPerform makeHardLink file key = do - replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do + replaceWorkTreeFile file $ \tmp -> do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file linkFromAnnex' key tmp mode >>= \case LinkAnnexFailed -> giveup "unable to make hard link" @@ -97,7 +97,7 @@ fixSymlink file link = do mtime <- liftIO $ catchMaybeIO $ Posix.modificationTimeHiRes <$> R.getSymbolicLinkStatus file #endif - replaceWorkTreeFile (fromRawFilePath file) $ \tmpfile -> do + replaceWorkTreeFile file $ \tmpfile -> do liftIO $ R.createSymbolicLink link tmpfile #if ! defined(mingw32_HOST_OS) liftIO $ maybe noop (\t -> touch tmpfile t False) mtime diff --git a/Command/Fsck.hs b/Command/Fsck.hs index bb2b1258a3..f0f833117d 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -45,6 +45,7 @@ import qualified Database.Fsck as FsckDb import Types.CleanupActions import Types.Key import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import Data.Time.Clock.POSIX import System.Posix.Types (EpochTime) @@ -417,7 +418,7 @@ verifyWorkTree key file = do case mk of Just k | k == key -> whenM (inAnnex key) $ do showNote "fixing worktree content" - replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do + replaceWorkTreeFile file $ \tmp -> do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file ifM (annexThin <$> Annex.getGitConfig) ( void $ linkFromAnnex' key tmp mode @@ -678,7 +679,7 @@ recordStartTime u = do f <- fromRepo (gitAnnexFsckState u) createAnnexDirectory $ parentDir f liftIO $ removeWhenExistsWith R.removeLink f - liftIO $ withFile (fromRawFilePath f) WriteMode $ \h -> do + liftIO $ F.withFile (toOsPath f) WriteMode $ \h -> do #ifndef mingw32_HOST_OS t <- modificationTime <$> R.getFileStatus f #else @@ -701,7 +702,7 @@ getStartTime u = do liftIO $ catchDefaultIO Nothing $ do timestamp <- modificationTime <$> R.getFileStatus f let fromstatus = Just (realToFrac timestamp) - fromfile <- parsePOSIXTime <$> readFile (fromRawFilePath f) + fromfile <- parsePOSIXTime <$> F.readFile' (toOsPath f) return $ if matchingtimestamp fromfile fromstatus then Just timestamp else Nothing diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index bdb16c9841..8adeb9a487 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -158,10 +158,11 @@ getFeed o url st = | scrapeOption o = scrape | otherwise = get - get = withTmpFile "feed" $ \tmpf h -> do + get = withTmpFile (toOsPath "feed") $ \tmpf h -> do + let tmpf' = fromRawFilePath $ fromOsPath tmpf liftIO $ hClose h - ifM (downloadFeed url tmpf) - ( parse tmpf + ifM (downloadFeed url tmpf') + ( parse tmpf' , do recordfail next $ feedProblem url diff --git a/Command/Lock.hs b/Command/Lock.hs index 7dbcffbbd9..96aebaab23 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -78,7 +78,7 @@ perform file key = do breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (R.getFileStatus obj)) $ do mfc <- withTSDelta (liftIO . genInodeCache file) unlessM (sameInodeCache obj (maybeToList mfc)) $ do - modifyContentDir obj $ replaceGitAnnexDirFile (fromRawFilePath obj) $ \tmp -> do + modifyContentDir obj $ replaceGitAnnexDirFile obj $ \tmp -> do unlessM (checkedCopyFile key obj tmp Nothing) $ giveup "unable to lock file" Database.Keys.storeInodeCaches key [obj] diff --git a/Command/Multicast.hs b/Command/Multicast.hs index 201fe7a6c9..abb589e205 100644 --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -130,7 +130,7 @@ send ups fs = do -- the names of keys, and would have to be copied, which is too -- expensive. starting "sending files" (ActionItemOther Nothing) (SeekInput []) $ - withTmpFile "send" $ \t h -> do + withTmpFile (toOsPath "send") $ \t h -> do let ww = WarnUnmatchLsFiles "multicast" (fs', cleanup) <- seekHelper id ww LsFiles.inRepo =<< workTreeItems ww fs @@ -163,7 +163,7 @@ send ups fs = do -- only allow clients on the authlist , Param "-H", Param ("@"++authlist) -- pass in list of files to send - , Param "-i", File t + , Param "-i", File (fromRawFilePath (fromOsPath t)) ] ++ ups liftIO (boolSystem "uftp" ps) >>= showEndResult next $ return True @@ -178,7 +178,7 @@ receive ups = starting "receiving multicast files" ai si $ do (callback, environ, statush) <- liftIO multicastCallbackEnv tmpobjdir <- fromRepo gitAnnexTmpObjectDir createAnnexDirectory tmpobjdir - withTmpDirIn (fromRawFilePath tmpobjdir) "multicast" $ \tmpdir -> withAuthList $ \authlist -> do + withTmpDirIn (fromRawFilePath tmpobjdir) (toOsPath "multicast") $ \tmpdir -> withAuthList $ \authlist -> do abstmpdir <- liftIO $ absPath (toRawFilePath tmpdir) abscallback <- liftIO $ searchPath callback let ps = @@ -245,10 +245,10 @@ uftpUID u = "0x" ++ (take 8 $ show $ sha2_256 $ B8.fromString (fromUUID u)) withAuthList :: (FilePath -> Annex a) -> Annex a withAuthList a = do m <- knownFingerPrints - withTmpFile "authlist" $ \t h -> do + withTmpFile (toOsPath "authlist") $ \t h -> do liftIO $ hPutStr h (genAuthList m) liftIO $ hClose h - a t + a (fromRawFilePath (fromOsPath t)) genAuthList :: M.Map UUID Fingerprint -> String genAuthList = unlines . map fmt . M.toList diff --git a/Command/P2P.hs b/Command/P2P.hs index 414ffa7610..14f6d24fa4 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -26,6 +26,7 @@ import Utility.FileMode import Utility.ThreadScheduler import Utility.SafeOutput import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified Utility.MagicWormhole as Wormhole import Control.Concurrent.Async @@ -193,12 +194,11 @@ serializePairData :: PairData -> String serializePairData (PairData (HalfAuthToken ha) addrs) = unlines $ T.unpack ha : map formatP2PAddress addrs -deserializePairData :: String -> Maybe PairData -deserializePairData s = case lines s of - [] -> Nothing - (ha:l) -> do - addrs <- mapM unformatP2PAddress l - return (PairData (HalfAuthToken (T.pack ha)) addrs) +deserializePairData :: [String] -> Maybe PairData +deserializePairData [] = Nothing +deserializePairData (ha:l) = do + addrs <- mapM unformatP2PAddress l + return (PairData (HalfAuthToken (T.pack ha)) addrs) data PairingResult = PairSuccess @@ -220,7 +220,7 @@ wormholePairing remotename ouraddrs ui = do -- files. Permissions of received files may allow others -- to read them. So, set up a temp directory that only -- we can read. - withTmpDir "pair" $ \tmp -> do + withTmpDir (toOsPath "pair") $ \tmp -> do liftIO $ void $ tryIO $ modifyFileMode (toRawFilePath tmp) $ removeModes otherGroupModes let sendf = tmp "send" @@ -245,13 +245,14 @@ wormholePairing remotename ouraddrs ui = do then return ReceiveFailed else do r <- liftIO $ tryIO $ - readFileStrict recvf + map decodeBS . fileLines' <$> F.readFile' + (toOsPath (toRawFilePath recvf)) case r of Left _e -> return ReceiveFailed - Right s -> maybe + Right ls -> maybe (return ReceiveFailed) (finishPairing 100 remotename ourhalf) - (deserializePairData s) + (deserializePairData ls) -- | Allow the peer we're pairing with to authenticate to us, -- using an authtoken constructed from the two HalfAuthTokens. diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs index 31ee330f4d..ac72c7053d 100644 --- a/Command/P2PHttp.hs +++ b/Command/P2PHttp.hs @@ -266,8 +266,8 @@ getAuthEnv = do findRepos :: Options -> IO [Git.Repo] findRepos o = do - files <- map toRawFilePath . concat - <$> mapM dirContents (directoryOption o) + files <- concat + <$> mapM (dirContents . toRawFilePath) (directoryOption o) map Git.Construct.newFrom . catMaybes <$> mapM Git.Construct.checkForRepo files diff --git a/Command/ReKey.hs b/Command/ReKey.hs index f092e85a84..a7a547b719 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -104,7 +104,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file) st <- liftIO $ R.getFileStatus file when (linkCount st > 1) $ do freezeContent oldobj - replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do + replaceWorkTreeFile file $ \tmp -> do unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $ giveup "can't lock old key" thawContent tmp diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs index aaa5c25ad2..2d003547b2 100644 --- a/Command/ResolveMerge.hs +++ b/Command/ResolveMerge.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.ResolveMerge where import Command @@ -12,8 +14,9 @@ import qualified Git import Git.Sha import qualified Git.Branch import Annex.AutoMerge +import qualified Utility.FileIO as F -import qualified Data.ByteString as S +import qualified System.FilePath.ByteString as P cmd :: Command cmd = command "resolvemerge" SectionPlumbing @@ -26,10 +29,10 @@ seek = withNothing (commandAction start) start :: CommandStart start = starting "resolvemerge" (ActionItemOther Nothing) (SeekInput []) $ do us <- fromMaybe nobranch <$> inRepo Git.Branch.current - d <- fromRawFilePath <$> fromRepo Git.localGitDir - let merge_head = d "MERGE_HEAD" + d <- fromRepo Git.localGitDir + let merge_head = toOsPath $ d P. "MERGE_HEAD" them <- fromMaybe (giveup nomergehead) . extractSha - <$> liftIO (S.readFile merge_head) + <$> liftIO (F.readFile' merge_head) ifM (resolveMerge (Just us) them False) ( do void $ commitResolvedMerge Git.Branch.ManualCommit diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index 2d96f7b1f7..eb643d7aad 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -32,6 +32,7 @@ import Annex.SpecialRemote.Config (exportTreeField) import Remote.Helper.Chunked import Remote.Helper.Encryptable (encryptionField, highRandomQualityField) import Git.Types +import qualified Utility.FileIO as F import Test.Tasty import Test.Tasty.Runners @@ -255,18 +256,18 @@ test runannex mkr mkk = get r k , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from 0" $ \r k -> do - tmp <- fromRawFilePath <$> prepTmp k - liftIO $ writeFile tmp "" + tmp <- toOsPath <$> prepTmp k + liftIO $ F.writeFile' tmp mempty lockContentForRemoval k noop removeAnnex get r k , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from 33%" $ \r k -> do loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k) - tmp <- fromRawFilePath <$> prepTmp k + tmp <- toOsPath <$> prepTmp k partial <- liftIO $ bracket (openBinaryFile loc ReadMode) hClose $ \h -> do sz <- hFileSize h L.hGet h $ fromInteger $ sz `div` 3 - liftIO $ L.writeFile tmp partial + liftIO $ F.writeFile tmp partial lockContentForRemoval k noop removeAnnex get r k , check "fsck downloaded object" fsck @@ -355,11 +356,11 @@ testExportTree runannex mkr mkk1 mkk2 = storeexport ea k = do loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k) Remote.storeExport ea loc k testexportlocation nullMeterUpdate - retrieveexport ea k = withTmpFile "exported" $ \tmp h -> do + retrieveexport ea k = withTmpFile (toOsPath "exported") $ \tmp h -> do liftIO $ hClose h - tryNonAsync (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) >>= \case + tryNonAsync (Remote.retrieveExport ea k testexportlocation (fromRawFilePath (fromOsPath tmp)) nullMeterUpdate) >>= \case Left _ -> return False - Right v -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify v k (toRawFilePath tmp) + Right v -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify v k (fromOsPath tmp) checkpresentexport ea k = Remote.checkPresentExport ea k testexportlocation removeexport ea k = Remote.removeExport ea k testexportlocation removeexportdirectory ea = case Remote.removeExportDirectory ea of @@ -429,21 +430,21 @@ keySizes base fast = filter want | otherwise = sz > 0 randKey :: Int -> Annex Key -randKey sz = withTmpFile "randkey" $ \f h -> do +randKey sz = withTmpFile (toOsPath "randkey") $ \f h -> do gen <- liftIO (newGenIO :: IO SystemRandom) case genBytes sz gen of Left e -> giveup $ "failed to generate random key: " ++ show e Right (rand, _) -> liftIO $ B.hPut h rand liftIO $ hClose h let ks = KeySource - { keyFilename = toRawFilePath f - , contentLocation = toRawFilePath f + { keyFilename = fromOsPath f + , contentLocation = fromOsPath f , inodeCache = Nothing } k <- case Types.Backend.genKey Backend.Hash.testKeyBackend of Just a -> a ks nullMeterUpdate Nothing -> giveup "failed to generate random key (backend problem)" - _ <- moveAnnex k (AssociatedFile Nothing) (toRawFilePath f) + _ <- moveAnnex k (AssociatedFile Nothing) (fromOsPath f) return k getReadonlyKey :: Remote -> RawFilePath -> Annex Key diff --git a/Command/Uninit.hs b/Command/Uninit.hs index a38ac9a7e6..d883467787 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -102,14 +102,14 @@ startCheckIncomplete recordnotok file key = removeAnnexDir :: CommandCleanup -> CommandStart removeAnnexDir recordok = do Annex.Queue.flush - annexdir <- fromRawFilePath <$> fromRepo gitAnnexDir + annexdir <- fromRepo gitAnnexDir annexobjectdir <- fromRepo gitAnnexObjectDir starting ("uninit objects") (ActionItemOther Nothing) (SeekInput []) $ do leftovers <- removeUnannexed =<< listKeys InAnnex prepareRemoveAnnexDir annexdir if null leftovers then do - liftIO $ removeDirectoryRecursive annexdir + liftIO $ removeDirectoryRecursive (fromRawFilePath annexdir) next recordok else giveup $ unlines [ "Not fully uninitialized" @@ -134,15 +134,15 @@ removeAnnexDir recordok = do - - Also closes sqlite databases that might be in the directory, - to avoid later failure to write any cached changes to them. -} -prepareRemoveAnnexDir :: FilePath -> Annex () +prepareRemoveAnnexDir :: RawFilePath -> Annex () prepareRemoveAnnexDir annexdir = do Database.Keys.closeDb liftIO $ prepareRemoveAnnexDir' annexdir -prepareRemoveAnnexDir' :: FilePath -> IO () +prepareRemoveAnnexDir' :: RawFilePath -> IO () prepareRemoveAnnexDir' annexdir = emptyWhenDoesNotExist (dirTreeRecursiveSkipping (const False) annexdir) - >>= mapM_ (void . tryIO . allowWrite . toRawFilePath) + >>= mapM_ (void . tryIO . allowWrite) {- Keys that were moved out of the annex have a hard link still in the - annex, with > 1 link count, and those can be removed. diff --git a/Command/Unlock.hs b/Command/Unlock.hs index c8faa7532f..e0f7ccb29a 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -51,7 +51,7 @@ start si file key = ifM (isJust <$> isAnnexLink file) perform :: RawFilePath -> Key -> CommandPerform perform dest key = do destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus dest - destic <- replaceWorkTreeFile (fromRawFilePath dest) $ \tmp -> do + destic <- replaceWorkTreeFile dest $ \tmp -> do ifM (inAnnex key) ( do r <- linkFromAnnex' key tmp destmode diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 806b5e5df0..426177ec69 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -35,6 +35,7 @@ import Remote import Git.Types (fromConfigKey, fromConfigValue) import Utility.DataUnits import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F cmd :: Command cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch" @@ -60,7 +61,10 @@ vicfg curcfg f = do -- Allow EDITOR to be processed by the shell, so it can contain options. unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $ giveup $ vi ++ " exited nonzero; aborting" - r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f) + r <- liftIO $ parseCfg (defCfg curcfg) + . map decodeBS + . fileLines' + <$> F.readFile' (toOsPath (toRawFilePath f)) liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) case r of Left s -> do @@ -278,8 +282,8 @@ lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l) {- If there's a parse error, returns a new version of the file, - with the problem lines noted. -} -parseCfg :: Cfg -> String -> Either String Cfg -parseCfg defcfg = go [] defcfg . lines +parseCfg :: Cfg -> [String] -> Either String Cfg +parseCfg defcfg = go [] defcfg where go c cfg [] | null (mapMaybe fst c) = Right cfg diff --git a/Common.hs b/Common.hs index c430163063..71681275f9 100644 --- a/Common.hs +++ b/Common.hs @@ -24,6 +24,7 @@ import Utility.Process as X import Utility.Path as X import Utility.Path.AbsRel as X import Utility.Directory as X +import Utility.SystemDirectory as X import Utility.MoveFile as X import Utility.Monad as X import Utility.Data as X @@ -32,5 +33,6 @@ import Utility.FileSize as X import Utility.Network as X import Utility.Split as X import Utility.FileSystemEncoding as X +import Utility.OsPath as X import Utility.PartialPrelude as X diff --git a/Config/Files/AutoStart.hs b/Config/Files/AutoStart.hs index 5c89bd2066..8b20644901 100644 --- a/Config/Files/AutoStart.hs +++ b/Config/Files/AutoStart.hs @@ -31,7 +31,9 @@ modifyAutoStartFile func = do f <- autoStartFile createDirectoryIfMissing True $ fromRawFilePath (parentDir (toRawFilePath f)) - viaTmp writeFile f $ unlines dirs' + viaTmp (writeFile . fromRawFilePath . fromOsPath) + (toOsPath (toRawFilePath f)) + (unlines dirs') {- Adds a directory to the autostart file. If the directory is already - present, it's moved to the top, so it will be used as the default diff --git a/Config/Smudge.hs b/Config/Smudge.hs index da198096fe..aa89990c0a 100644 --- a/Config/Smudge.hs +++ b/Config/Smudge.hs @@ -17,7 +17,9 @@ import Git.Types import Config import Utility.Directory.Create import Annex.Version +import qualified Utility.FileIO as F +import qualified Data.ByteString as S import qualified System.FilePath.ByteString as P configureSmudgeFilter :: Annex () @@ -44,11 +46,12 @@ configureSmudgeFilter = unlessM (fromRepo Git.repoIsLocalBare) $ do lfs <- readattr lf gfs <- readattr gf gittop <- Git.localGitDir <$> gitRepo - liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do + liftIO $ unless ("filter=annex" `S.isInfixOf` (lfs <> gfs)) $ do createDirectoryUnder [gittop] (P.takeDirectory lf) - writeFile (fromRawFilePath lf) (lfs ++ "\n" ++ unlines stdattr) + F.writeFile' (toOsPath lf) $ + linesFile' (lfs <> encodeBS ("\n" ++ unlines stdattr)) where - readattr = liftIO . catchDefaultIO "" . readFileStrict . fromRawFilePath + readattr = liftIO . catchDefaultIO mempty . F.readFile' . toOsPath configureSmudgeFilterProcess :: Annex () configureSmudgeFilterProcess = @@ -65,9 +68,10 @@ stdattr = -- git-annex does not commit that. deconfigureSmudgeFilter :: Annex () deconfigureSmudgeFilter = do - lf <- fromRawFilePath <$> Annex.fromRepo Git.attributesLocal - ls <- liftIO $ catchDefaultIO [] $ lines <$> readFileStrict lf - liftIO $ writeFile lf $ unlines $ + lf <- Annex.fromRepo Git.attributesLocal + ls <- liftIO $ catchDefaultIO [] $ + map decodeBS . fileLines' <$> F.readFile' (toOsPath lf) + liftIO $ writeFile (fromRawFilePath lf) $ unlines $ filter (\l -> l `notElem` stdattr && not (null l)) ls unsetConfig (ConfigKey "filter.annex.smudge") unsetConfig (ConfigKey "filter.annex.clean") diff --git a/Creds.hs b/Creds.hs index e429d796cf..3bbf6f7b28 100644 --- a/Creds.hs +++ b/Creds.hs @@ -37,9 +37,10 @@ import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, Encry import Utility.Env (getEnv) import Utility.Base64 import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F -import qualified Data.ByteString.Lazy.Char8 as L -import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy.Char8 as L8 +import qualified Data.ByteString.Char8 as S8 import qualified Data.Map as M import qualified System.FilePath.ByteString as P @@ -99,7 +100,7 @@ setRemoteCredPair' pc encsetup gc storage mcreds = case mcreds of storeconfig creds key (Just cipher) = do cmd <- gpgCmd <$> Annex.getGitConfig s <- liftIO $ encrypt cmd (pc, gc) cipher - (feedBytes $ L.pack $ encodeCredPair creds) + (feedBytes $ L8.pack $ encodeCredPair creds) (readBytesStrictly return) storeconfig' key (Accepted (decodeBS (toB64 s))) storeconfig creds key Nothing = @@ -135,8 +136,8 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv fromenccreds enccreds cipher storablecipher = do cmd <- gpgCmd <$> Annex.getGitConfig mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (c, gc) cipher - (feedBytes $ L.fromStrict $ fromB64 enccreds) - (readBytesStrictly $ return . S.unpack) + (feedBytes $ L8.fromStrict $ fromB64 enccreds) + (readBytesStrictly $ return . S8.unpack) case mcreds of Just creds -> fromcreds creds Nothing -> do @@ -202,7 +203,10 @@ writeCreds creds file = do liftIO $ writeFileProtected (d P. toRawFilePath file) creds readCreds :: FilePath -> Annex (Maybe Creds) -readCreds f = liftIO . catchMaybeIO . readFileStrict =<< credsFile f +readCreds f = do + f' <- toOsPath . toRawFilePath <$> credsFile f + liftIO $ catchMaybeIO $ decodeBS . S8.unlines . fileLines' + <$> F.readFile' f' credsFile :: FilePath -> Annex FilePath credsFile basefile = do diff --git a/Crypto.hs b/Crypto.hs index 192c19bc78..b28814f0ea 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -211,7 +211,7 @@ encrypt gpgcmd c cipher feeder reader = case cipher of Cipher{} -> let passphrase = cipherPassphrase cipher in case statelessOpenPGPCommand c of - Just sopcmd -> withTmpDir "sop" $ \d -> + Just sopcmd -> withTmpDir (toOsPath "sop") $ \d -> SOP.encryptSymmetric sopcmd passphrase (SOP.EmptyDirectory d) (statelessOpenPGPProfile c) @@ -233,7 +233,7 @@ decrypt cmd c cipher feeder reader = case cipher of Cipher{} -> let passphrase = cipherPassphrase cipher in case statelessOpenPGPCommand c of - Just sopcmd -> withTmpDir "sop" $ \d -> + Just sopcmd -> withTmpDir (toOsPath "sop") $ \d -> SOP.decryptSymmetric sopcmd passphrase (SOP.EmptyDirectory d) feeder reader diff --git a/Database/Benchmark.hs b/Database/Benchmark.hs index 81f3531891..552236df95 100644 --- a/Database/Benchmark.hs +++ b/Database/Benchmark.hs @@ -31,7 +31,7 @@ import qualified System.FilePath.ByteString as P benchmarkDbs :: CriterionMode -> Integer -> Annex () #ifdef WITH_BENCHMARK -benchmarkDbs mode n = withTmpDirIn "." "benchmark" $ \tmpdir -> do +benchmarkDbs mode n = withTmpDirIn "." (toOsPath "benchmark") $ \tmpdir -> do db <- benchDb (toRawFilePath tmpdir) n liftIO $ runMode mode [ bgroup "keys database" diff --git a/Git/HashObject.hs b/Git/HashObject.hs index 620c095141..704d310c9d 100644 --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Git.HashObject where @@ -82,10 +82,10 @@ instance HashableBlob Builder where {- Injects a blob into git. Unfortunately, the current git-hash-object - interface does not allow batch hashing without using temp files. -} hashBlob :: HashableBlob b => HashObjectHandle -> b -> IO Sha -hashBlob h b = withTmpFile "hash" $ \tmp tmph -> do +hashBlob h b = withTmpFile (toOsPath "hash") $ \tmp tmph -> do hashableBlobToHandle tmph b hClose tmph - hashFile h (toRawFilePath tmp) + hashFile h (fromOsPath tmp) {- Injects some content into git, returning its Sha. - diff --git a/Git/Hook.hs b/Git/Hook.hs index 1163f1effe..c2e5a8125e 100644 --- a/Git/Hook.hs +++ b/Git/Hook.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Git.Hook where @@ -14,15 +15,16 @@ import Git import Utility.Tmp import Utility.Shell import Utility.FileMode +import qualified Utility.FileIO as F #ifndef mingw32_HOST_OS import qualified Utility.RawFilePath as R import System.PosixCompat.Files (fileMode) #endif -import qualified Data.ByteString as B +import qualified System.FilePath.ByteString as P data Hook = Hook - { hookName :: FilePath + { hookName :: RawFilePath , hookScript :: String , hookOldScripts :: [String] } @@ -31,8 +33,8 @@ data Hook = Hook instance Eq Hook where a == b = hookName a == hookName b -hookFile :: Hook -> Repo -> FilePath -hookFile h r = fromRawFilePath (localGitDir r) "hooks" hookName h +hookFile :: Hook -> Repo -> RawFilePath +hookFile h r = localGitDir r P. "hooks" P. hookName h {- Writes a hook. Returns False if the hook already exists with a different - content. Upgrades old scripts. @@ -48,7 +50,7 @@ hookFile h r = fromRawFilePath (localGitDir r) "hooks" hookName h - is run with a bundled bash, so should start with #!/bin/sh -} hookWrite :: Hook -> Repo -> IO Bool -hookWrite h r = ifM (doesFileExist f) +hookWrite h r = ifM (doesFileExist (fromRawFilePath f)) ( expectedContent h r >>= \case UnexpectedContent -> return False ExpectedContent -> return True @@ -58,15 +60,13 @@ hookWrite h r = ifM (doesFileExist f) where f = hookFile h r go = do - -- On Windows, using B.writeFile here avoids - -- the newline translation done by writeFile. + -- On Windows, using a ByteString as the file content + -- avoids the newline translation done by writeFile. -- Hook scripts on Windows could use CRLF endings, but -- they typically use unix newlines, which does work there -- and makes the repository more portable. - viaTmp B.writeFile f (encodeBS (hookScript h)) - void $ tryIO $ modifyFileMode - (toRawFilePath f) - (addModes executeModes) + viaTmp F.writeFile' (toOsPath f) (encodeBS (hookScript h)) + void $ tryIO $ modifyFileMode f (addModes executeModes) return True {- Removes a hook. Returns False if the hook contained something else, and @@ -81,7 +81,7 @@ hookUnWrite h r = ifM (doesFileExist f) , return True ) where - f = hookFile h r + f = fromRawFilePath $ hookFile h r data ExpectedContent = UnexpectedContent | ExpectedContent | OldExpectedContent @@ -91,7 +91,7 @@ expectedContent h r = do -- and so a hook file that has CRLF will be treated the same as one -- that has LF. That is intentional, since users may have a reason -- to prefer one or the other. - content <- readFile $ hookFile h r + content <- readFile $ fromRawFilePath $ hookFile h r return $ if content == hookScript h then ExpectedContent else if any (content ==) (hookOldScripts h) @@ -103,13 +103,13 @@ hookExists h r = do let f = hookFile h r catchBoolIO $ #ifndef mingw32_HOST_OS - isExecutable . fileMode <$> R.getFileStatus (toRawFilePath f) + isExecutable . fileMode <$> R.getFileStatus f #else - doesFileExist f + doesFileExist (fromRawFilePath f) #endif runHook :: (FilePath -> [CommandParam] -> IO a) -> Hook -> [CommandParam] -> Repo -> IO a runHook runner h ps r = do - let f = hookFile h r + let f = fromRawFilePath $ hookFile h r (c, cps) <- findShellCommand f runner c (cps ++ ps) diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 4eea39541a..08c98b7fda 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -373,4 +373,4 @@ inodeCaches locs repo = guardSafeForLsFiles repo $ do mkInodeCache <$> (readish =<< M.lookup "ino:" m) <*> (readish =<< M.lookup "size:" m) - <*> (parsePOSIXTime =<< (replace ":" "." <$> M.lookup "mtime:" m)) + <*> (parsePOSIXTime =<< (encodeBS . replace ":" "." <$> M.lookup "mtime:" m)) diff --git a/Git/Objects.hs b/Git/Objects.hs index 1390209e97..b66b0b5e19 100644 --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -25,14 +25,14 @@ packDir r = objectsDir r P. "pack" packIdxFile :: RawFilePath -> RawFilePath packIdxFile = flip P.replaceExtension "idx" -listPackFiles :: Repo -> IO [FilePath] -listPackFiles r = filter (".pack" `isSuffixOf`) - <$> catchDefaultIO [] (dirContents $ fromRawFilePath $ packDir r) +listPackFiles :: Repo -> IO [RawFilePath] +listPackFiles r = filter (".pack" `B.isSuffixOf`) + <$> catchDefaultIO [] (dirContents $ packDir r) listLooseObjectShas :: Repo -> IO [Sha] listLooseObjectShas r = catchDefaultIO [] $ - mapMaybe (extractSha . encodeBS . concat . reverse . take 2 . reverse . splitDirectories) - <$> emptyWhenDoesNotExist (dirContentsRecursiveSkipping (== "pack") True (fromRawFilePath (objectsDir r))) + mapMaybe (extractSha . encodeBS . concat . reverse . take 2 . reverse . splitDirectories . decodeBS) + <$> emptyWhenDoesNotExist (dirContentsRecursiveSkipping (== "pack") True (objectsDir r)) looseObjectFile :: Repo -> Sha -> RawFilePath looseObjectFile r sha = objectsDir r P. prefix P. rest diff --git a/Git/Ref.hs b/Git/Ref.hs index 2767ae339c..c6b2027280 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -15,19 +15,22 @@ import Git.Command import Git.Sha import Git.Types import Git.FilePath +import qualified Utility.FileIO as F import Data.Char (chr, ord) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 +import qualified System.FilePath.ByteString as P headRef :: Ref headRef = Ref "HEAD" -headFile :: Repo -> FilePath -headFile r = fromRawFilePath (localGitDir r) "HEAD" +headFile :: Repo -> RawFilePath +headFile r = localGitDir r P. "HEAD" setHeadRef :: Ref -> Repo -> IO () -setHeadRef ref r = S.writeFile (headFile r) ("ref: " <> fromRef' ref) +setHeadRef ref r = + F.writeFile' (toOsPath (headFile r)) ("ref: " <> fromRef' ref) {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String diff --git a/Git/Repair.hs b/Git/Repair.hs index ace7ae89af..ed46161cfe 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -44,8 +44,10 @@ import Utility.Tmp.Dir import Utility.Rsync import Utility.FileMode import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified Data.Set as S +import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified System.FilePath.ByteString as P @@ -78,29 +80,28 @@ explodePacks :: Repo -> IO Bool explodePacks r = go =<< listPackFiles r where go [] = return False - go packs = withTmpDir "packs" $ \tmpdir -> do + go packs = withTmpDir (toOsPath "packs") $ \tmpdir -> do r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" tmpdir putStrLn "Unpacking all pack files." forM_ packs $ \packfile -> do -- Just in case permissions are messed up. - allowRead (toRawFilePath packfile) + allowRead packfile -- May fail, if pack file is corrupt. void $ tryIO $ pipeWrite [Param "unpack-objects", Param "-r"] r' $ \h -> - L.hPut h =<< L.readFile packfile - objs <- emptyWhenDoesNotExist (dirContentsRecursive tmpdir) + L.hPut h =<< F.readFile (toOsPath packfile) + objs <- emptyWhenDoesNotExist (dirContentsRecursive (toRawFilePath tmpdir)) forM_ objs $ \objfile -> do f <- relPathDirToFile (toRawFilePath tmpdir) - (toRawFilePath objfile) + objfile let dest = objectsDir r P. f createDirectoryIfMissing True (fromRawFilePath (parentDir dest)) - moveFile (toRawFilePath objfile) dest + moveFile objfile dest forM_ packs $ \packfile -> do - let f = toRawFilePath packfile - removeWhenExistsWith R.removeLink f - removeWhenExistsWith R.removeLink (packIdxFile f) + removeWhenExistsWith R.removeLink packfile + removeWhenExistsWith R.removeLink (packIdxFile packfile) return True {- Try to retrieve a set of missing objects, from the remotes of a @@ -113,13 +114,13 @@ explodePacks r = go =<< listPackFiles r retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResults retrieveMissingObjects missing referencerepo r | not (foundBroken missing) = return missing - | otherwise = withTmpDir "tmprepo" $ \tmpdir -> do + | otherwise = withTmpDir (toOsPath "tmprepo") $ \tmpdir -> do unlessM (boolSystem "git" [Param "init", File tmpdir]) $ giveup $ "failed to create temp repository in " ++ tmpdir tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir) - let repoconfig r' = fromRawFilePath (localGitDir r' P. "config") - whenM (doesFileExist (repoconfig r)) $ - L.readFile (repoconfig r) >>= L.writeFile (repoconfig tmpr) + let repoconfig r' = toOsPath (localGitDir r' P. "config") + whenM (doesFileExist (fromRawFilePath (fromOsPath (repoconfig r)))) $ + F.readFile (repoconfig r) >>= F.writeFile (repoconfig tmpr) rs <- Construct.fromRemotes r stillmissing <- pullremotes tmpr rs fetchrefstags missing if S.null (knownMissing stillmissing) @@ -248,13 +249,14 @@ badBranches missing r = filterM isbad =<< getAllRefs r - Relies on packed refs being exploded before it's called. -} getAllRefs :: Repo -> IO [Ref] -getAllRefs r = getAllRefs' (fromRawFilePath (localGitDir r) "refs") +getAllRefs r = getAllRefs' (localGitDir r P. "refs") -getAllRefs' :: FilePath -> IO [Ref] +getAllRefs' :: RawFilePath -> IO [Ref] getAllRefs' refdir = do - let topsegs = length (splitPath refdir) - 1 + let topsegs = length (P.splitPath refdir) - 1 let toref = Ref . toInternalGitPath . encodeBS - . joinPath . drop topsegs . splitPath + . joinPath . drop topsegs . splitPath + . decodeBS map toref <$> emptyWhenDoesNotExist (dirContentsRecursive refdir) explodePackedRefsFile :: Repo -> IO () @@ -262,7 +264,9 @@ explodePackedRefsFile r = do let f = packedRefsFile r let f' = toRawFilePath f whenM (doesFileExist f) $ do - rs <- mapMaybe parsePacked . lines + rs <- mapMaybe parsePacked + . map decodeBS + . fileLines' <$> catchDefaultIO "" (safeReadFile f') forM_ rs makeref removeWhenExistsWith R.removeLink f' @@ -473,7 +477,7 @@ displayList items header -} preRepair :: Repo -> IO () preRepair g = do - unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do + unlessM (validhead <$> catchDefaultIO "" (decodeBS <$> safeReadFile headfile)) $ do removeWhenExistsWith R.removeLink headfile writeFile (fromRawFilePath headfile) "ref: refs/heads/master" explodePackedRefsFile g @@ -651,7 +655,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do successfulRepair :: (Bool, [Branch]) -> Bool successfulRepair = fst -safeReadFile :: RawFilePath -> IO String +safeReadFile :: RawFilePath -> IO B.ByteString safeReadFile f = do allowRead f - readFileStrict (fromRawFilePath f) + F.readFile' (toOsPath f) diff --git a/Logs/AdjustedBranchUpdate.hs b/Logs/AdjustedBranchUpdate.hs index c7f2822945..5b2ea9648a 100644 --- a/Logs/AdjustedBranchUpdate.hs +++ b/Logs/AdjustedBranchUpdate.hs @@ -80,5 +80,5 @@ parseAdjustLog l = "1" -> Just True "0" -> Just False _ -> Nothing - t <- parsePOSIXTime ts + t <- parsePOSIXTime (encodeBS ts) return (b, t) diff --git a/Logs/Export.hs b/Logs/Export.hs index 7f2242ea14..a3cf823d53 100644 --- a/Logs/Export.hs +++ b/Logs/Export.hs @@ -34,6 +34,7 @@ import Logs.File import qualified Git.LsTree import qualified Git.Tree import Annex.UUID +import qualified Utility.FileIO as F import qualified Data.Map as M import qualified Data.ByteString as B @@ -129,7 +130,7 @@ getExportExcluded :: UUID -> Annex [Git.Tree.TreeItem] getExportExcluded u = do logf <- fromRepo $ gitAnnexExportExcludeLog u liftIO $ catchDefaultIO [] $ exportExcludedParser - <$> L.readFile (fromRawFilePath logf) + <$> F.readFile (toOsPath logf) where exportExcludedParser :: L.ByteString -> [Git.Tree.TreeItem] diff --git a/Logs/File.hs b/Logs/File.hs index e129da0553..93aef17f97 100644 --- a/Logs/File.hs +++ b/Logs/File.hs @@ -26,9 +26,8 @@ import Annex.Perms import Annex.LockFile import Annex.ReplaceFile import Utility.Tmp +import qualified Utility.FileIO as F -import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8 @@ -36,23 +35,23 @@ import qualified Data.ByteString.Lazy.Char8 as L8 -- making the new file have whatever permissions the git repository is -- configured to use. Creates the parent directory when necessary. writeLogFile :: RawFilePath -> String -> Annex () -writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (fromRawFilePath f) c +writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (toOsPath f) c where writelog tmp c' = do - liftIO $ writeFile tmp c' - setAnnexFilePerm (toRawFilePath tmp) + liftIO $ writeFile (fromRawFilePath (fromOsPath tmp)) c' + setAnnexFilePerm (fromOsPath tmp) -- | Runs the action with a handle connected to a temp file. -- The temp file replaces the log file once the action succeeds. withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a withLogHandle f a = do createAnnexDirectory (parentDir f) - replaceGitAnnexDirFile (fromRawFilePath f) $ \tmp -> + replaceGitAnnexDirFile f $ \tmp -> bracket (setup tmp) cleanup a where setup tmp = do setAnnexFilePerm tmp - liftIO $ openFile (fromRawFilePath tmp) WriteMode + liftIO $ F.openFile (toOsPath tmp) WriteMode cleanup h = liftIO $ hClose h -- | Appends a line to a log file, first locking it to prevent @@ -61,11 +60,9 @@ appendLogFile :: RawFilePath -> RawFilePath -> L.ByteString -> Annex () appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do - liftIO $ withFile f' AppendMode $ + liftIO $ F.withFile (toOsPath f) AppendMode $ \h -> L8.hPutStrLn h c - setAnnexFilePerm (toRawFilePath f') - where - f' = fromRawFilePath f + setAnnexFilePerm f -- | Modifies a log file. -- @@ -78,29 +75,28 @@ appendLogFile f lck c = modifyLogFile :: RawFilePath -> RawFilePath -> ([L.ByteString] -> [L.ByteString]) -> Annex () modifyLogFile f lck modf = withExclusiveLock lck $ do ls <- liftIO $ fromMaybe [] - <$> tryWhenExists (fileLines <$> L.readFile f') + <$> tryWhenExists (fileLines <$> F.readFile f') let ls' = modf ls when (ls' /= ls) $ createDirWhenNeeded f $ viaTmp writelog f' (L8.unlines ls') where - f' = fromRawFilePath f + f' = toOsPath f writelog lf b = do - liftIO $ L.writeFile lf b - setAnnexFilePerm (toRawFilePath lf) + liftIO $ F.writeFile lf b + setAnnexFilePerm (fromOsPath lf) -- | Checks the content of a log file to see if any line matches. checkLogFile :: RawFilePath -> RawFilePath -> (L.ByteString -> Bool) -> Annex Bool checkLogFile f lck matchf = withSharedLock lck $ bracket setup cleanup go where - setup = liftIO $ tryWhenExists $ openFile f' ReadMode + setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode cleanup Nothing = noop cleanup (Just h) = liftIO $ hClose h go Nothing = return False go (Just h) = do !r <- liftIO (any matchf . fileLines <$> L.hGetContents h) return r - f' = fromRawFilePath f -- | Folds a function over lines of a log file to calculate a value. calcLogFile :: RawFilePath -> RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t @@ -111,7 +107,7 @@ calcLogFile f lck start update = calcLogFileUnsafe :: RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t calcLogFileUnsafe f start update = bracket setup cleanup go where - setup = liftIO $ tryWhenExists $ openFile f' ReadMode + setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode cleanup Nothing = noop cleanup (Just h) = liftIO $ hClose h go Nothing = return start @@ -120,7 +116,6 @@ calcLogFileUnsafe f start update = bracket setup cleanup go go' v (l:ls) = do let !v' = update l v go' v' ls - f' = fromRawFilePath f -- | Streams lines from a log file, passing each line to the processor, -- and then empties the file at the end. @@ -134,19 +129,19 @@ calcLogFileUnsafe f start update = bracket setup cleanup go -- -- Locking is used to prevent writes to to the log file while this -- is running. -streamLogFile :: FilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex () +streamLogFile :: RawFilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex () streamLogFile f lck finalizer processor = withExclusiveLock lck $ do streamLogFileUnsafe f finalizer processor - liftIO $ writeFile f "" - setAnnexFilePerm (toRawFilePath f) + liftIO $ F.writeFile' (toOsPath f) mempty + setAnnexFilePerm f -- Unsafe version that does not do locking, and does not empty the file -- at the end. -streamLogFileUnsafe :: FilePath -> Annex () -> (String -> Annex ()) -> Annex () +streamLogFileUnsafe :: RawFilePath -> Annex () -> (String -> Annex ()) -> Annex () streamLogFileUnsafe f finalizer processor = bracketOnError setup cleanup go where - setup = liftIO $ tryWhenExists $ openFile f ReadMode + setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode cleanup Nothing = noop cleanup (Just h) = liftIO $ hClose h go Nothing = finalizer @@ -161,32 +156,3 @@ createDirWhenNeeded f a = a `catchNonAsync` \_e -> do -- done if writing the file fails. createAnnexDirectory (parentDir f) a - --- On windows, readFile does NewlineMode translation, --- stripping CR before LF. When converting to ByteString, --- use this to emulate that. -fileLines :: L.ByteString -> [L.ByteString] -#ifdef mingw32_HOST_OS -fileLines = map stripCR . L8.lines - where - stripCR b = case L8.unsnoc b of - Nothing -> b - Just (b', e) - | e == '\r' -> b' - | otherwise -> b -#else -fileLines = L8.lines -#endif - -fileLines' :: S.ByteString -> [S.ByteString] -#ifdef mingw32_HOST_OS -fileLines' = map stripCR . S8.lines - where - stripCR b = case S8.unsnoc b of - Nothing -> b - Just (b', e) - | e == '\r' -> b' - | otherwise -> b -#else -fileLines' = S8.lines -#endif diff --git a/Logs/Migrate.hs b/Logs/Migrate.hs index b60b21cfcb..63ace2f92e 100644 --- a/Logs/Migrate.hs +++ b/Logs/Migrate.hs @@ -79,7 +79,7 @@ logMigration old new = do -- | Commits a migration to the git-annex branch. commitMigration :: Annex () commitMigration = do - logf <- fromRawFilePath <$> fromRepo gitAnnexMigrateLog + logf <- fromRepo gitAnnexMigrateLog lckf <- fromRepo gitAnnexMigrateLock nv <- liftIO $ newTVarIO (0 :: Integer) g <- Annex.gitRepo diff --git a/Logs/Restage.hs b/Logs/Restage.hs index 5d4e2e0910..dc9a35940c 100644 --- a/Logs/Restage.hs +++ b/Logs/Restage.hs @@ -14,6 +14,7 @@ import Git.FilePath import Logs.File import Utility.InodeCache import Annex.LockFile +import qualified Utility.FileIO as F import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L @@ -48,21 +49,20 @@ streamRestageLog :: Annex () -> (TopFilePath -> InodeCache -> Annex ()) -> Annex streamRestageLog finalizer processor = do logf <- fromRepo gitAnnexRestageLog oldf <- fromRepo gitAnnexRestageLogOld - let oldf' = fromRawFilePath oldf lckf <- fromRepo gitAnnexRestageLock withExclusiveLock lckf $ liftIO $ whenM (R.doesPathExist logf) $ ifM (R.doesPathExist oldf) ( do - h <- openFile oldf' AppendMode + h <- F.openFile (toOsPath oldf) AppendMode hPutStr h =<< readFile (fromRawFilePath logf) hClose h liftIO $ removeWhenExistsWith R.removeLink logf , moveFile logf oldf ) - streamLogFileUnsafe oldf' finalizer $ \l -> + streamLogFileUnsafe oldf finalizer $ \l -> case parseRestageLog l of Just (f, ic) -> processor f ic Nothing -> noop diff --git a/Logs/Smudge.hs b/Logs/Smudge.hs index 7b0f5ff5f6..5a667ec826 100644 --- a/Logs/Smudge.hs +++ b/Logs/Smudge.hs @@ -34,7 +34,7 @@ streamSmudged :: (Key -> TopFilePath -> Annex ()) -> Annex () streamSmudged a = do logf <- fromRepo gitAnnexSmudgeLog lckf <- fromRepo gitAnnexSmudgeLock - streamLogFile (fromRawFilePath logf) lckf noop $ \l -> + streamLogFile logf lckf noop $ \l -> case parse l of Nothing -> noop Just (k, f) -> a k f diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 88c2f947cc..387311b219 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -22,6 +22,7 @@ import Annex.LockPool import Utility.TimeStamp import Logs.File import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F #ifndef mingw32_HOST_OS import Annex.Perms #endif @@ -29,6 +30,7 @@ import Annex.Perms import Data.Time.Clock import Data.Time.Clock.POSIX import Control.Concurrent.STM +import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified System.FilePath.ByteString as P @@ -118,7 +120,7 @@ checkTransfer t = debugLocks $ do (Just oldlck, _) -> getLockStatus oldlck case v' of StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $ - readTransferInfoFile (Just pid) (fromRawFilePath tfile) + readTransferInfoFile (Just pid) tfile _ -> do mode <- annexFileMode -- Ignore failure due to permissions, races, etc. @@ -139,7 +141,7 @@ checkTransfer t = debugLocks $ do v <- liftIO $ lockShared lck liftIO $ case v of Nothing -> catchDefaultIO Nothing $ - readTransferInfoFile Nothing (fromRawFilePath tfile) + readTransferInfoFile Nothing tfile Just lockhandle -> do dropLock lockhandle deletestale @@ -157,7 +159,7 @@ getTransfers' dirs wanted = do infos <- mapM checkTransfer transfers return $ mapMaybe running $ zip transfers infos where - findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive . fromRawFilePath) + findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive) =<< mapM (fromRepo . transferDir) dirs running (t, Just i) = Just (t, i) running (_, Nothing) = Nothing @@ -184,7 +186,7 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles return $ case (mt, mi) of (Just t, Just i) -> Just (t, i) _ -> Nothing - findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive . fromRawFilePath) + findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive) =<< mapM (fromRepo . failedTransferDir u) [Download, Upload] clearFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)] @@ -244,17 +246,17 @@ failedTransferFile (Transfer direction u kd) r = P. keyFile (mkKey (const kd)) {- Parses a transfer information filename to a Transfer. -} -parseTransferFile :: FilePath -> Maybe Transfer +parseTransferFile :: RawFilePath -> Maybe Transfer parseTransferFile file - | "lck." `isPrefixOf` takeFileName file = Nothing + | "lck." `B.isPrefixOf` P.takeFileName file = Nothing | otherwise = case drop (length bits - 3) bits of [direction, u, key] -> Transfer <$> parseDirection direction <*> pure (toUUID u) - <*> fmap (fromKey id) (fileKey (toRawFilePath key)) + <*> fmap (fromKey id) (fileKey key) _ -> Nothing where - bits = splitDirectories file + bits = P.splitDirectories file writeTransferInfoFile :: TransferInfo -> RawFilePath -> Annex () writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info @@ -284,9 +286,9 @@ writeTransferInfo info = unlines in maybe "" fromRawFilePath afile ] -readTransferInfoFile :: Maybe PID -> FilePath -> IO (Maybe TransferInfo) +readTransferInfoFile :: Maybe PID -> RawFilePath -> IO (Maybe TransferInfo) readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ - readTransferInfo mpid <$> readFileStrict tfile + readTransferInfo mpid . decodeBS <$> F.readFile' (toOsPath tfile) readTransferInfo :: Maybe PID -> String -> Maybe TransferInfo readTransferInfo mpid s = TransferInfo @@ -303,8 +305,10 @@ readTransferInfo mpid s = TransferInfo <*> pure False where #ifdef mingw32_HOST_OS - (firstline, otherlines) = separate (== '\n') s - (secondline, rest) = separate (== '\n') otherlines + (firstliner, otherlines) = separate (== '\n') s + (secondliner, rest) = separate (== '\n') otherlines + firstline = dropWhileEnd (== '\r') firstliner + secondline = dropWhileEnd (== '\r') secondliner mpid' = readish secondline #else (firstline, rest) = separate (== '\n') s @@ -315,7 +319,7 @@ readTransferInfo mpid s = TransferInfo bits = splitc ' ' firstline numbits = length bits time = if numbits > 0 - then Just <$> parsePOSIXTime =<< headMaybe bits + then Just <$> parsePOSIXTime . encodeBS =<< headMaybe bits else pure Nothing -- not failure bytes = if numbits > 1 then Just <$> readish =<< headMaybe (drop 1 bits) diff --git a/Logs/Unused.hs b/Logs/Unused.hs index 6bb1011e84..fa2b2ce3cc 100644 --- a/Logs/Unused.hs +++ b/Logs/Unused.hs @@ -32,6 +32,7 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.Time.Clock.POSIX import Data.Time +import qualified Utility.FileIO as F import Annex.Common import qualified Annex @@ -73,14 +74,14 @@ writeUnusedLog prefix l = do readUnusedLog :: RawFilePath -> Annex UnusedLog readUnusedLog prefix = do - f <- fromRawFilePath <$> fromRepo (gitAnnexUnusedLog prefix) - ifM (liftIO $ doesFileExist f) - ( M.fromList . mapMaybe parse . lines - <$> liftIO (readFileStrict f) + f <- fromRepo (gitAnnexUnusedLog prefix) + ifM (liftIO $ doesFileExist (fromRawFilePath f)) + ( M.fromList . mapMaybe (parse . decodeBS) . fileLines' + <$> liftIO (F.readFile' (toOsPath f)) , return M.empty ) where - parse line = case (readish sint, deserializeKey skey, parsePOSIXTime ts) of + parse line = case (readish sint, deserializeKey skey, parsePOSIXTime (encodeBS ts)) of (Just int, Just key, mtimestamp) -> Just (key, (int, mtimestamp)) _ -> Nothing where diff --git a/Logs/Upgrade.hs b/Logs/Upgrade.hs index f1ff0bd56c..bc63e0021f 100644 --- a/Logs/Upgrade.hs +++ b/Logs/Upgrade.hs @@ -19,6 +19,7 @@ import Annex.Common import Utility.TimeStamp import Logs.File import Types.RepoVersion +import qualified Utility.FileIO as F import Data.Time.Clock.POSIX @@ -31,14 +32,14 @@ writeUpgradeLog v t = do readUpgradeLog :: Annex [(RepoVersion, POSIXTime)] readUpgradeLog = do - logfile <- fromRawFilePath <$> fromRepo gitAnnexUpgradeLog - ifM (liftIO $ doesFileExist logfile) - ( mapMaybe parse . lines - <$> liftIO (readFileStrict logfile) + logfile <- fromRepo gitAnnexUpgradeLog + ifM (liftIO $ doesFileExist (fromRawFilePath logfile)) + ( mapMaybe (parse . decodeBS) . fileLines' + <$> liftIO (F.readFile' (toOsPath logfile)) , return [] ) where - parse line = case (readish sint, parsePOSIXTime ts) of + parse line = case (readish sint, parsePOSIXTime (encodeBS ts)) of (Just v, Just t) -> Just (RepoVersion v, t) _ -> Nothing where diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index c9c15d75ed..6d3599764f 100644 --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -35,10 +35,11 @@ import qualified Utility.RawFilePath as R import Network.URI import qualified System.FilePath.ByteString as P +import qualified Data.ByteString as S #ifdef WITH_TORRENTPARSER import Data.Torrent -import qualified Data.ByteString.Lazy as B +import qualified Utility.FileIO as F #endif remote :: RemoteType @@ -208,31 +209,29 @@ downloadTorrentFile u = do let metadir = othertmp P. "torrentmeta" P. kf createAnnexDirectory metadir showOutput - ok <- downloadMagnetLink u - (fromRawFilePath metadir) - (fromRawFilePath torrent) + ok <- downloadMagnetLink u metadir torrent liftIO $ removeDirectoryRecursive (fromRawFilePath metadir) return ok else withOtherTmp $ \othertmp -> do - withTmpFileIn (fromRawFilePath othertmp) "torrent" $ \f h -> do + withTmpFileIn (toOsPath othertmp) (toOsPath "torrent") $ \f h -> do liftIO $ hClose h - resetAnnexFilePerm (toRawFilePath f) + resetAnnexFilePerm (fromOsPath f) ok <- Url.withUrlOptions $ - Url.download nullMeterUpdate Nothing u f + Url.download nullMeterUpdate Nothing u (fromRawFilePath (fromOsPath f)) when ok $ - liftIO $ moveFile (toRawFilePath f) torrent + liftIO $ moveFile (fromOsPath f) torrent return ok ) -downloadMagnetLink :: URLString -> FilePath -> FilePath -> Annex Bool +downloadMagnetLink :: URLString -> RawFilePath -> RawFilePath -> Annex Bool downloadMagnetLink u metadir dest = ifM download ( liftIO $ do - ts <- filter (".torrent" `isSuffixOf`) + ts <- filter (".torrent" `S.isSuffixOf`) <$> dirContents metadir case ts of (t:[]) -> do - moveFile (toRawFilePath t) (toRawFilePath dest) + moveFile t dest return True _ -> return False , return False @@ -245,7 +244,7 @@ downloadMagnetLink u metadir dest = ifM download , Param "--seed-time=0" , Param "--summary-interval=0" , Param "-d" - , File metadir + , File (fromRawFilePath metadir) ] downloadTorrentContent :: Key -> URLString -> FilePath -> Int -> MeterUpdate -> Annex Bool @@ -367,7 +366,7 @@ torrentFileSizes :: RawFilePath -> IO [(FilePath, Integer)] torrentFileSizes torrent = do #ifdef WITH_TORRENTPARSER let mkfile = joinPath . map (scrub . decodeBL) - b <- B.readFile (fromRawFilePath torrent) + b <- F.readFile (toOsPath torrent) return $ case readTorrent b of Left e -> giveup $ "failed to parse torrent: " ++ e Right t -> case tInfo t of diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 1086e7cf64..d2f03e0735 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -15,7 +15,6 @@ module Remote.Directory ( removeDirGeneric, ) where -import qualified Data.ByteString.Lazy as L import qualified Data.Map as M import qualified Data.List.NonEmpty as NE import qualified System.FilePath.ByteString as P @@ -52,6 +51,7 @@ import Utility.InodeCache import Utility.FileMode import Utility.Directory.Create import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F #ifndef mingw32_HOST_OS import Utility.OpenFd #endif @@ -241,12 +241,12 @@ checkDiskSpaceDirectory d k = do - down. -} finalizeStoreGeneric :: RawFilePath -> RawFilePath -> RawFilePath -> IO () finalizeStoreGeneric d tmp dest = do - removeDirGeneric False (fromRawFilePath d) dest' + removeDirGeneric False d dest createDirectoryUnder [d] (parentDir dest) renameDirectory (fromRawFilePath tmp) dest' -- may fail on some filesystems void $ tryIO $ do - mapM_ (preventWrite . toRawFilePath) =<< dirContents dest' + mapM_ preventWrite =<< dirContents dest preventWrite dest where dest' = fromRawFilePath dest @@ -257,7 +257,7 @@ retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do src <- liftIO $ fromRawFilePath <$> getLocation d k void $ liftIO $ fileCopier cow src (fromRawFilePath dest) p iv retrieveKeyFileM d _ _ = byteRetriever $ \k sink -> - sink =<< liftIO (L.readFile . fromRawFilePath =<< getLocation d k) + sink =<< liftIO (F.readFile . toOsPath =<< getLocation d k) retrieveKeyFileCheapM :: RawFilePath -> ChunkConfig -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ()) -- no cheap retrieval possible for chunks @@ -275,9 +275,7 @@ retrieveKeyFileCheapM _ _ = Nothing #endif removeKeyM :: RawFilePath -> Remover -removeKeyM d _proof k = liftIO $ removeDirGeneric True - (fromRawFilePath d) - (fromRawFilePath (storeDir d k)) +removeKeyM d _proof k = liftIO $ removeDirGeneric True d (storeDir d k) {- Removes the directory, which must be located under the topdir. - @@ -293,28 +291,30 @@ removeKeyM d _proof k = liftIO $ removeDirGeneric True - can also be removed. Failure to remove such a directory is not treated - as an error. -} -removeDirGeneric :: Bool -> FilePath -> FilePath -> IO () +removeDirGeneric :: Bool -> RawFilePath -> RawFilePath -> IO () removeDirGeneric removeemptyparents topdir dir = do - void $ tryIO $ allowWrite (toRawFilePath dir) + void $ tryIO $ allowWrite dir #ifdef mingw32_HOST_OS {- Windows needs the files inside the directory to be writable - before it can delete them. -} - void $ tryIO $ mapM_ (allowWrite . toRawFilePath) =<< dirContents dir + void $ tryIO $ mapM_ allowWrite =<< dirContents dir #endif - tryNonAsync (removeDirectoryRecursive dir) >>= \case + tryNonAsync (removeDirectoryRecursive dir') >>= \case Right () -> return () Left e -> - unlessM (doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)) $ + unlessM (doesDirectoryExist topdir' <&&> (not <$> doesDirectoryExist dir')) $ throwM e when removeemptyparents $ do - subdir <- relPathDirToFile (toRawFilePath topdir) (P.takeDirectory (toRawFilePath dir)) + subdir <- relPathDirToFile topdir (P.takeDirectory dir) goparents (Just (P.takeDirectory subdir)) (Right ()) where goparents _ (Left _e) = return () goparents Nothing _ = return () goparents (Just subdir) _ = do - let d = topdir fromRawFilePath subdir + let d = topdir' fromRawFilePath subdir goparents (upFrom subdir) =<< tryIO (removeDirectory d) + dir' = fromRawFilePath dir + topdir' = fromRawFilePath topdir checkPresentM :: RawFilePath -> ChunkConfig -> CheckPresent checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations' k @@ -338,10 +338,10 @@ storeExportM d cow src _k loc p = do liftIO $ createDirectoryUnder [d] (P.takeDirectory dest) -- Write via temp file so that checkPresentGeneric will not -- see it until it's fully stored. - viaTmp go (fromRawFilePath dest) () + viaTmp go (toOsPath dest) () where dest = exportPath d loc - go tmp () = void $ liftIO $ fileCopier cow src tmp p Nothing + go tmp () = void $ liftIO $ fileCopier cow src (fromRawFilePath (fromOsPath tmp)) p Nothing retrieveExportM :: RawFilePath -> CopyCoWTried -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification retrieveExportM d cow k loc dest p = @@ -389,8 +389,7 @@ removeExportLocation topdir loc = listImportableContentsM :: IgnoreInodes -> RawFilePath -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize))) listImportableContentsM ii dir = liftIO $ do - l <- dirContentsRecursiveSkipping (const False) False (fromRawFilePath dir) - l' <- mapM (go . toRawFilePath) l + l' <- mapM go =<< dirContentsRecursiveSkipping (const False) False dir return $ Just $ ImportableContentsComplete $ ImportableContents (catMaybes l') [] where @@ -542,11 +541,11 @@ retrieveExportWithContentIdentifierM ii dir cow loc cids dest gk p = storeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do - liftIO $ createDirectoryUnder [dir] (toRawFilePath destdir) - withTmpFileIn destdir template $ \tmpf tmph -> do + liftIO $ createDirectoryUnder [dir] destdir + withTmpFileIn (toOsPath destdir) template $ \tmpf tmph -> do + let tmpf' = fromOsPath tmpf liftIO $ hClose tmph - void $ liftIO $ fileCopier cow src tmpf p Nothing - let tmpf' = toRawFilePath tmpf + void $ liftIO $ fileCopier cow src (fromRawFilePath tmpf') p Nothing resetAnnexFilePerm tmpf' liftIO (R.getSymbolicLinkStatus tmpf') >>= liftIO . mkContentIdentifier ii tmpf' >>= \case Nothing -> giveup "unable to generate content identifier" @@ -558,8 +557,8 @@ storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do return newcid where dest = exportPath dir loc - (destdir, base) = splitFileName (fromRawFilePath dest) - template = relatedTemplate (base ++ ".tmp") + (destdir, base) = P.splitFileName dest + template = relatedTemplate (base <> ".tmp") removeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex () removeExportWithContentIdentifierM ii dir k loc removeablecids = diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs index 2268dc998a..b1b2438b7d 100644 --- a/Remote/Directory/LegacyChunked.hs +++ b/Remote/Directory/LegacyChunked.hs @@ -24,6 +24,7 @@ import Annex.Tmp import Utility.Metered import Utility.Directory.Create import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool withCheckedFiles _ [] _locations _ _ = return False @@ -101,13 +102,13 @@ retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever retrieve locations d basek p _dest miv c = withOtherTmp $ \tmpdir -> do showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow." let tmp = tmpdir P. keyFile basek <> ".directorylegacy.tmp" - let tmp' = fromRawFilePath tmp + let tmp' = toOsPath tmp let go = \k sink -> do liftIO $ void $ withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ \fs -> do forM_ fs $ - S.appendFile tmp' <=< S.readFile + F.appendFile' tmp' <=< S.readFile return True - b <- liftIO $ L.readFile tmp' + b <- liftIO $ F.readFile tmp' liftIO $ removeWhenExistsWith R.removeLink tmp sink b byteRetriever go basek p tmp miv c diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 8a3852c6b1..ce8564bd76 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -439,8 +439,8 @@ remove' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> AccessMethod -> Remov remove' repo r rsyncopts accessmethod proof k | not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ liftIO $ Remote.Directory.removeDirGeneric True - (gCryptTopDir repo) - (fromRawFilePath (parentDir (toRawFilePath (gCryptLocation repo k)))) + (toRawFilePath (gCryptTopDir repo)) + (parentDir (toRawFilePath (gCryptLocation repo k))) | Git.repoIsSsh repo = shellOrRsync r removeshell removersync | accessmethod == AccessRsyncOverSsh = removersync | otherwise = unsupportedUrl @@ -529,9 +529,10 @@ getConfigViaRsync r gc = do let (rsynctransport, rsyncurl, _) = rsyncTransport r gc opts <- rsynctransport liftIO $ do - withTmpFile "tmpconfig" $ \tmpconfig _ -> do + withTmpFile (toOsPath "tmpconfig") $ \tmpconfig _ -> do + let tmpconfig' = fromRawFilePath $ fromOsPath tmpconfig void $ rsync $ opts ++ [ Param $ rsyncurl ++ "/config" - , Param tmpconfig + , Param tmpconfig' ] - Git.Config.fromFile r tmpconfig + Git.Config.fromFile r tmpconfig' diff --git a/Remote/Git.hs b/Remote/Git.hs index 2dc132501e..c9108700e4 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -324,9 +324,10 @@ tryGitConfigRead autoinit r hasuuid geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do let url = Git.repoLocation r ++ "/config" - v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do + v <- withTmpFile (toOsPath "git-annex.tmp") $ \tmpfile h -> do liftIO $ hClose h - Url.download' nullMeterUpdate Nothing url tmpfile uo >>= \case + let tmpfile' = fromRawFilePath $ fromOsPath tmpfile + Url.download' nullMeterUpdate Nothing url tmpfile' uo >>= \case Right () -> pipedconfig Git.Config.ConfigNullList False url "git" @@ -334,7 +335,7 @@ tryGitConfigRead autoinit r hasuuid , Param "--null" , Param "--list" , Param "--file" - , File tmpfile + , File tmpfile' ] >>= return . \case Right r' -> Right r' Left exitcode -> Left $ "git config exited " ++ show exitcode diff --git a/Remote/Helper/Git.hs b/Remote/Helper/Git.hs index 1567e7ae6a..a8f6798662 100644 --- a/Remote/Helper/Git.hs +++ b/Remote/Helper/Git.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Remote.Helper.Git where import Annex.Common @@ -21,6 +23,7 @@ import Data.Time.Clock.POSIX import System.PosixCompat.Files (modificationTime) import qualified Data.Map as M import qualified Data.Set as S +import qualified System.FilePath.ByteString as P repoCheap :: Git.Repo -> Bool repoCheap = not . Git.repoIsUrl @@ -59,9 +62,9 @@ guardUsable r fallback a gitRepoInfo :: Remote -> Annex [(String, String)] gitRepoInfo r = do - d <- fromRawFilePath <$> fromRepo Git.localGitDir - mtimes <- liftIO $ mapM (\p -> modificationTime <$> R.getFileStatus (toRawFilePath p)) - =<< emptyWhenDoesNotExist (dirContentsRecursive (d "refs" "remotes" Remote.name r)) + d <- fromRepo Git.localGitDir + mtimes <- liftIO $ mapM (\p -> modificationTime <$> R.getFileStatus p) + =<< emptyWhenDoesNotExist (dirContentsRecursive (d P. "refs" P. "remotes" P. encodeBS (Remote.name r))) let lastsynctime = case mtimes of [] -> "never" _ -> show $ posixSecondsToUTCTime $ realToFrac $ maximum mtimes diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index cea6cd3566..5a908f9c67 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -374,7 +374,7 @@ sendParams = ifM crippledFileSystem withRsyncScratchDir :: (FilePath -> Annex a) -> Annex a withRsyncScratchDir a = do t <- fromRawFilePath <$> fromRepo gitAnnexTmpObjectDir - withTmpDirIn t "rsynctmp" a + withTmpDirIn t (toOsPath "rsynctmp") a rsyncRetrieve :: RsyncOpts -> [RsyncUrl] -> FilePath -> Maybe MeterUpdate -> Annex () rsyncRetrieve o rsyncurls dest meterupdate = diff --git a/Test.hs b/Test.hs index 77a4029bbc..6c231c9859 100644 --- a/Test.hs +++ b/Test.hs @@ -563,7 +563,7 @@ test_magic = intmpclonerepo $ do #endif test_import :: Assertion -test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir "importtest" $ \importdir -> do +test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir (toOsPath (toRawFilePath "importtest")) $ \importdir -> do (toimport1, importf1, imported1) <- mktoimport importdir "import1" git_annex "import" [toimport1] "import" annexed_present_imported imported1 @@ -1894,7 +1894,7 @@ test_gpg_crypto = do testscheme "pubkey" where gpgcmd = Utility.Gpg.mkGpgCmd Nothing - testscheme scheme = Utility.Tmp.Dir.withTmpDir "gpgtmp" $ \gpgtmp -> do + testscheme scheme = Utility.Tmp.Dir.withTmpDir (toOsPath (toRawFilePath "gpgtmp")) $ \gpgtmp -> do -- Use the system temp directory as gpg temp directory because -- it needs to be able to store the agent socket there, -- which can be problematic when testing some filesystems. diff --git a/Test/Framework.hs b/Test/Framework.hs index b9b8bcde79..94354eb521 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Test.Framework where import Test.Tasty @@ -302,7 +304,7 @@ ensuredir d = do - happen concurrently with a test case running, and would be a problem - since setEnv is not thread safe. This is run before tasty. -} setTestEnv :: IO a -> IO a -setTestEnv a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do +setTestEnv a = Utility.Tmp.Dir.withTmpDir (toOsPath "testhome") $ \tmphome -> do tmphomeabs <- fromRawFilePath <$> absPath (toRawFilePath tmphome) {- Prevent global git configs from affecting the test suite. -} Utility.Env.Set.setEnv "HOME" tmphomeabs True @@ -339,14 +341,14 @@ removeDirectoryForCleanup = removePathForcibly cleanup :: FilePath -> IO () cleanup dir = whenM (doesDirectoryExist dir) $ do - Command.Uninit.prepareRemoveAnnexDir' dir + Command.Uninit.prepareRemoveAnnexDir' (toRawFilePath dir) -- This can fail if files in the directory are still open by a -- subprocess. void $ tryIO $ removeDirectoryForCleanup dir finalCleanup :: IO () finalCleanup = whenM (doesDirectoryExist tmpdir) $ do - Command.Uninit.prepareRemoveAnnexDir' tmpdir + Command.Uninit.prepareRemoveAnnexDir' (toRawFilePath tmpdir) catchIO (removeDirectoryForCleanup tmpdir) $ \e -> do print e putStrLn "sleeping 10 seconds and will retry directory cleanup" diff --git a/Types/Direction.hs b/Types/Direction.hs index a18b83697d..814b66f72b 100644 --- a/Types/Direction.hs +++ b/Types/Direction.hs @@ -18,7 +18,7 @@ formatDirection :: Direction -> B.ByteString formatDirection Upload = "upload" formatDirection Download = "download" -parseDirection :: String -> Maybe Direction +parseDirection :: B.ByteString -> Maybe Direction parseDirection "upload" = Just Upload parseDirection "download" = Just Download parseDirection _ = Nothing diff --git a/Types/Distribution.hs b/Types/Distribution.hs index 3a7aca1f2e..7616efc9e7 100644 --- a/Types/Distribution.hs +++ b/Types/Distribution.hs @@ -40,10 +40,9 @@ formatInfoFile :: GitAnnexDistribution -> String formatInfoFile d = replace "keyVariant = " "keyBackendName = " (show d) ++ "\n" ++ formatGitAnnexDistribution d -parseInfoFile :: String -> Maybe GitAnnexDistribution -parseInfoFile s = case lines s of - (_oldformat:rest) -> parseGitAnnexDistribution (unlines rest) - _ -> Nothing +parseInfoFile :: [String] -> Maybe GitAnnexDistribution +parseInfoFile (_oldformat:rest) = parseGitAnnexDistribution (unlines rest) +parseInfoFile _ = Nothing formatGitAnnexDistribution :: GitAnnexDistribution -> String formatGitAnnexDistribution d = unlines diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index bad2cfbc07..5540844a70 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -15,7 +15,6 @@ import Data.Default import Data.ByteString.Builder import qualified Data.ByteString as S import qualified Data.ByteString.Short as S (toShort, fromShort) -import qualified Data.ByteString.Lazy as L import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isRegularFile) import Text.Read @@ -35,6 +34,7 @@ import Utility.FileMode import Utility.Tmp import qualified Upgrade.V2 import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F -- v2 adds hashing of filenames of content and location log files. -- Key information is encoded in filenames differently, so @@ -198,11 +198,13 @@ fileKey1 file = readKey1 $ replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file writeLog1 :: FilePath -> [LogLine] -> IO () -writeLog1 file ls = viaTmp L.writeFile file (toLazyByteString $ buildLog ls) +writeLog1 file ls = viaTmp F.writeFile + (toOsPath (toRawFilePath file)) + (toLazyByteString $ buildLog ls) readLog1 :: FilePath -> IO [LogLine] readLog1 file = catchDefaultIO [] $ - parseLog . encodeBL <$> readFileStrict file + parseLog <$> F.readFile (toOsPath (toRawFilePath file)) lookupKey1 :: FilePath -> Annex (Maybe (Key, Backend)) lookupKey1 file = do diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index f467fa2596..7690921232 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -20,6 +20,7 @@ import Annex.Content import Utility.Tmp import Logs import Messages.Progress +import qualified Utility.FileIO as F olddir :: Git.Repo -> FilePath olddir g @@ -73,14 +74,14 @@ locationLogs = do config <- Annex.getGitConfig dir <- fromRepo gitStateDir liftIO $ do - levela <- dirContents dir + levela <- dirContents (toRawFilePath dir) levelb <- mapM tryDirContents levela files <- mapM tryDirContents (concat levelb) return $ mapMaybe (islogfile config) (concat files) where tryDirContents d = catchDefaultIO [] $ dirContents d - islogfile config f = maybe Nothing (\k -> Just (k, f)) $ - locationLogFileKey config (toRawFilePath f) + islogfile config f = maybe Nothing (\k -> Just (k, fromRawFilePath f)) $ + locationLogFileKey config f inject :: FilePath -> FilePath -> Annex () inject source dest = do @@ -135,12 +136,15 @@ attrLines = gitAttributesUnWrite :: Git.Repo -> IO () gitAttributesUnWrite repo = do - let attributes = fromRawFilePath (Git.attributes repo) - whenM (doesFileExist attributes) $ do - c <- readFileStrict attributes - liftIO $ viaTmp writeFile attributes $ unlines $ - filter (`notElem` attrLines) $ lines c - Git.Command.run [Param "add", File attributes] repo + let attributes = Git.attributes repo + let attributes' = fromRawFilePath attributes + whenM (doesFileExist attributes') $ do + c <- map decodeBS . fileLines' + <$> F.readFile' (toOsPath attributes) + liftIO $ viaTmp (writeFile . fromRawFilePath . fromOsPath) + (toOsPath attributes) + (unlines $ filter (`notElem` attrLines) c) + Git.Command.run [Param "add", File attributes'] repo stateDir :: FilePath stateDir = addTrailingPathSeparator ".git-annex" diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs index e6cb22a6d4..708c838977 100644 --- a/Upgrade/V5.hs +++ b/Upgrade/V5.hs @@ -34,8 +34,7 @@ import Utility.InodeCache import Utility.DottedVersion import Annex.AdjustedBranch import qualified Utility.RawFilePath as R - -import qualified Data.ByteString as S +import qualified Utility.FileIO as F upgrade :: Bool -> Annex UpgradeResult upgrade automatic = flip catchNonAsync onexception $ do @@ -130,7 +129,7 @@ upgradeDirectWorkTree = do Just k -> do stagePointerFile f Nothing =<< hashPointerFile k ifM (isJust <$> getAnnexLinkTarget f) - ( writepointer (fromRawFilePath f) k + ( writepointer f k , fromdirect (fromRawFilePath f) k ) Database.Keys.addAssociatedFile k @@ -158,8 +157,8 @@ upgradeDirectWorkTree = do ) writepointer f k = liftIO $ do - removeWhenExistsWith R.removeLink (toRawFilePath f) - S.writeFile f (formatPointer k) + removeWhenExistsWith R.removeLink f + F.writeFile' (toOsPath f) (formatPointer k) {- Remove all direct mode bookkeeping files. -} removeDirectCruft :: Annex () diff --git a/Upgrade/V5/Direct.hs b/Upgrade/V5/Direct.hs index c807b29d9e..f03d7b3780 100644 --- a/Upgrade/V5/Direct.hs +++ b/Upgrade/V5/Direct.hs @@ -29,6 +29,7 @@ import Annex.Perms import Utility.InodeCache import Annex.InodeSentinal import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F setIndirect :: Annex () setIndirect = do @@ -88,8 +89,8 @@ associatedFiles key = do - the top of the repo. -} associatedFilesRelative :: Key -> Annex [FilePath] associatedFilesRelative key = do - mapping <- fromRawFilePath <$> calcRepo (gitAnnexMapping key) - liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h -> + mapping <- calcRepo (gitAnnexMapping key) + liftIO $ catchDefaultIO [] $ F.withFile (toOsPath mapping) ReadMode $ \h -> -- Read strictly to ensure the file is closed promptly lines <$> hGetContentsStrict h @@ -118,8 +119,8 @@ goodContent key file = recordedInodeCache :: Key -> Annex [InodeCache] recordedInodeCache key = withInodeCacheFile key $ \f -> liftIO $ catchDefaultIO [] $ - mapMaybe readInodeCache . lines - <$> readFileStrict (fromRawFilePath f) + mapMaybe (readInodeCache . decodeBS) . fileLines' + <$> F.readFile' (toOsPath f) {- Removes an inode cache. -} removeInodeCache :: Key -> Annex () diff --git a/Upgrade/V7.hs b/Upgrade/V7.hs index cad16f1854..0e301bd09d 100644 --- a/Upgrade/V7.hs +++ b/Upgrade/V7.hs @@ -22,6 +22,7 @@ import qualified Git import Git.FilePath import Config import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isSymbolicLink) @@ -127,11 +128,12 @@ populateKeysDb = unlessM isBareRepo $ do -- checked into the repository. updateSmudgeFilter :: Annex () updateSmudgeFilter = do - lf <- fromRawFilePath <$> Annex.fromRepo Git.attributesLocal - ls <- liftIO $ lines <$> catchDefaultIO "" (readFileStrict lf) + lf <- Annex.fromRepo Git.attributesLocal + ls <- liftIO $ map decodeBS . fileLines' + <$> catchDefaultIO "" (F.readFile' (toOsPath lf)) let ls' = removedotfilter ls when (ls /= ls') $ - liftIO $ writeFile lf (unlines ls') + liftIO $ writeFile (fromRawFilePath lf) (unlines ls') where removedotfilter ("* filter=annex":".* !filter":rest) = "* filter=annex" : removedotfilter rest diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index c2a3d1bde7..38f8d09aee 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -189,6 +189,6 @@ winLockFile pid pidfile = do prefix = pidfile ++ "." suffix = ".lck" cleanstale = mapM_ (void . tryIO . removeFile) =<< - (filter iswinlockfile <$> dirContents (fromRawFilePath (parentDir (toRawFilePath pidfile)))) + (filter iswinlockfile . map fromRawFilePath <$> dirContents (parentDir (toRawFilePath pidfile))) iswinlockfile f = suffix `isSuffixOf` f && prefix `isPrefixOf` f #endif diff --git a/Utility/DirWatcher/FSEvents.hs b/Utility/DirWatcher/FSEvents.hs index 7b6be6f13b..da2b3194bc 100644 --- a/Utility/DirWatcher/FSEvents.hs +++ b/Utility/DirWatcher/FSEvents.hs @@ -70,7 +70,8 @@ watchDir dir ignored scanevents hooks = do scan d = unless (ignoredPath ignored d) $ -- Do not follow symlinks when scanning. -- This mirrors the inotify startup scan behavior. - mapM_ go =<< emptyWhenDoesNotExist (dirContentsRecursiveSkipping (const False) False d) + mapM_ (go . fromRawFilePath) =<< emptyWhenDoesNotExist + (dirContentsRecursiveSkipping (const False) False (toRawFilePath d)) where go f | ignoredPath ignored f = noop diff --git a/Utility/DirWatcher/INotify.hs b/Utility/DirWatcher/INotify.hs index 700bff5773..4b14e85bd2 100644 --- a/Utility/DirWatcher/INotify.hs +++ b/Utility/DirWatcher/INotify.hs @@ -59,7 +59,7 @@ watchDir i dir ignored scanevents hooks void (addWatch i watchevents (toInternalFilePath dir) handler) `catchIO` failedaddwatch withLock lock $ - mapM_ scan =<< filter (not . dirCruft) <$> + mapM_ scan =<< filter (not . dirCruft . toRawFilePath) <$> getDirectoryContents dir where recurse d = watchDir i d ignored scanevents hooks diff --git a/Utility/DirWatcher/Kqueue.hs b/Utility/DirWatcher/Kqueue.hs index dc9fed31c2..b793eee58b 100644 --- a/Utility/DirWatcher/Kqueue.hs +++ b/Utility/DirWatcher/Kqueue.hs @@ -77,7 +77,7 @@ data DirInfo = DirInfo getDirInfo :: FilePath -> IO DirInfo getDirInfo dir = do - l <- filter (not . dirCruft) <$> getDirectoryContents dir + l <- filter (not . dirCruft . toRawFilePath) <$> getDirectoryContents dir contents <- S.fromList . catMaybes <$> mapM getDirEnt l return $ DirInfo dir contents where diff --git a/Utility/DirWatcher/Win32Notify.hs b/Utility/DirWatcher/Win32Notify.hs index e5ce316ce6..5f53c13bf5 100644 --- a/Utility/DirWatcher/Win32Notify.hs +++ b/Utility/DirWatcher/Win32Notify.hs @@ -43,7 +43,8 @@ watchDir dir ignored scanevents hooks = do runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks) scan d = unless (ignoredPath ignored d) $ - mapM_ go =<< emptyWhenDoesNotExist (dirContentsRecursiveSkipping (const False) False d) + mapM_ (go . fromRawFilePath) =<< emptyWhenDoesNotExist + (dirContentsRecursiveSkipping (const False) False (toRawFilePath d)) where go f | ignoredPath ignored f = noop diff --git a/Utility/Directory.hs b/Utility/Directory.hs index bf997b8606..3648a4454d 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -1,42 +1,48 @@ {- directory traversal and manipulation - - - Copyright 2011-2023 Joey Hess + - Copyright 2011-2025 Joey Hess - - License: BSD-2-clause -} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Directory ( - module Utility.Directory, - module Utility.SystemDirectory -) where +module Utility.Directory where +#ifdef WITH_OSPATH +import System.Directory.OsPath +#else +import Utility.SystemDirectory +#endif import Control.Monad -import System.FilePath import System.PosixCompat.Files (isDirectory, isSymbolicLink) import Control.Applicative import System.IO.Unsafe (unsafeInterleaveIO) +import qualified System.FilePath.ByteString as P import Data.Maybe import Prelude -import Utility.SystemDirectory +import Utility.OsPath import Utility.Exception import Utility.Monad import Utility.FileSystemEncoding import qualified Utility.RawFilePath as R -dirCruft :: FilePath -> Bool +dirCruft :: R.RawFilePath -> Bool dirCruft "." = True dirCruft ".." = True dirCruft _ = False {- Lists the contents of a directory. - Unlike getDirectoryContents, paths are not relative to the directory. -} -dirContents :: FilePath -> IO [FilePath] -dirContents d = map (d ) . filter (not . dirCruft) <$> getDirectoryContents d +dirContents :: RawFilePath -> IO [RawFilePath] +dirContents d = + map (\p -> d P. fromOsPath p) + . filter (not . dirCruft . fromOsPath) + <$> getDirectoryContents (toOsPath d) {- Gets files in a directory, and then its subdirectories, recursively, - and lazily. @@ -48,13 +54,13 @@ dirContents d = map (d ) . filter (not . dirCruft) <$> getDirectoryContents d - be accessed (the use of unsafeInterleaveIO would make it difficult to - trap such exceptions). -} -dirContentsRecursive :: FilePath -> IO [FilePath] +dirContentsRecursive :: RawFilePath -> IO [RawFilePath] dirContentsRecursive = dirContentsRecursiveSkipping (const False) True {- Skips directories whose basenames match the skipdir. -} -dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath] +dirContentsRecursiveSkipping :: (RawFilePath -> Bool) -> Bool -> RawFilePath -> IO [RawFilePath] dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir - | skipdir (takeFileName topdir) = return [] + | skipdir (P.takeFileName topdir) = return [] | otherwise = do -- Get the contents of the top directory outside of -- unsafeInterleaveIO, which allows throwing exceptions if @@ -66,24 +72,26 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir where go [] = return [] go (dir:dirs) - | skipdir (takeFileName dir) = go dirs + | skipdir (P.takeFileName dir) = go dirs | otherwise = unsafeInterleaveIO $ do (files, dirs') <- collect [] [] =<< catchDefaultIO [] (dirContents dir) files' <- go (dirs' ++ dirs) return (files ++ files') + + collect :: [RawFilePath] -> [RawFilePath] -> [RawFilePath] -> IO ([RawFilePath], [RawFilePath]) collect files dirs' [] = return (reverse files, reverse dirs') collect files dirs' (entry:entries) | dirCruft entry = collect files dirs' entries | otherwise = do let skip = collect (entry:files) dirs' entries let recurse = collect files (entry:dirs') entries - ms <- catchMaybeIO $ R.getSymbolicLinkStatus (toRawFilePath entry) + ms <- catchMaybeIO $ R.getSymbolicLinkStatus entry case ms of (Just s) | isDirectory s -> recurse | isSymbolicLink s && followsubdirsymlinks -> - ifM (doesDirectoryExist entry) + ifM (doesDirectoryExist (toOsPath entry)) ( recurse , skip ) @@ -98,22 +106,22 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir - be accessed (the use of unsafeInterleaveIO would make it difficult to - trap such exceptions). -} -dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath] +dirTreeRecursiveSkipping :: (RawFilePath -> Bool) -> RawFilePath -> IO [RawFilePath] dirTreeRecursiveSkipping skipdir topdir - | skipdir (takeFileName topdir) = return [] + | skipdir (P.takeFileName topdir) = return [] | otherwise = do subdirs <- filterM isdir =<< dirContents topdir go [] subdirs where go c [] = return c go c (dir:dirs) - | skipdir (takeFileName dir) = go c dirs + | skipdir (P.takeFileName dir) = go c dirs | otherwise = unsafeInterleaveIO $ do subdirs <- go [] =<< filterM isdir =<< catchDefaultIO [] (dirContents dir) go (subdirs++dir:c) dirs - isdir p = isDirectory <$> R.getSymbolicLinkStatus (toRawFilePath p) + isdir p = isDirectory <$> R.getSymbolicLinkStatus p {- When the action fails due to the directory not existing, returns []. -} emptyWhenDoesNotExist :: IO [a] -> IO [a] diff --git a/Utility/Directory/Stream.hs b/Utility/Directory/Stream.hs index 3a6222c561..a74416d2f8 100644 --- a/Utility/Directory/Stream.hs +++ b/Utility/Directory/Stream.hs @@ -1,6 +1,6 @@ -{- streaming directory traversal +{- streaming directory reading - - - Copyright 2011-2018 Joey Hess + - Copyright 2011-2025 Joey Hess - - License: BSD-2-clause -} @@ -14,23 +14,25 @@ module Utility.Directory.Stream ( openDirectory, closeDirectory, readDirectory, - isDirectoryEmpty, + isDirectoryPopulated, ) where import Control.Monad -import System.FilePath import Control.Concurrent import Data.Maybe import Prelude #ifdef mingw32_HOST_OS import qualified System.Win32 as Win32 +import System.FilePath #else -import qualified System.Posix as Posix +import qualified Data.ByteString as B +import qualified System.Posix.Directory.ByteString as Posix #endif import Utility.Directory import Utility.Exception +import Utility.FileSystemEncoding #ifndef mingw32_HOST_OS data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream @@ -40,14 +42,14 @@ data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar type IsOpen = MVar () -- full when the handle is open -openDirectory :: FilePath -> IO DirectoryHandle +openDirectory :: RawFilePath -> IO DirectoryHandle openDirectory path = do #ifndef mingw32_HOST_OS dirp <- Posix.openDirStream path isopen <- newMVar () return (DirectoryHandle isopen dirp) #else - (h, fdat) <- Win32.findFirstFile (path "*") + (h, fdat) <- Win32.findFirstFile (fromRawFilePath path "*") -- Indicate that the fdat contains a filename that readDirectory -- has not yet returned, by making the MVar be full. -- (There's always at least a "." entry.) @@ -75,11 +77,11 @@ closeDirectory (DirectoryHandle isopen h _ alreadyhave) = -- | Reads the next entry from the handle. Once the end of the directory -- is reached, returns Nothing and automatically closes the handle. -readDirectory :: DirectoryHandle -> IO (Maybe FilePath) +readDirectory :: DirectoryHandle -> IO (Maybe RawFilePath) #ifndef mingw32_HOST_OS readDirectory hdl@(DirectoryHandle _ dirp) = do e <- Posix.readDirStream dirp - if null e + if B.null e then do closeDirectory hdl return Nothing @@ -102,18 +104,18 @@ readDirectory hdl@(DirectoryHandle _ h fdat mv) = do where getfn = do filename <- Win32.getFindDataFileName fdat - return (Just filename) + return (Just (toRawFilePath filename)) #endif --- | True only when directory exists and contains nothing. --- Throws exception if directory does not exist. -isDirectoryEmpty :: FilePath -> IO Bool -isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check +-- | True only when directory exists and is not empty. +isDirectoryPopulated :: RawFilePath -> IO Bool +isDirectoryPopulated d = bracket (openDirectory d) closeDirectory check + `catchIO` const (return False) where check h = do v <- readDirectory h case v of - Nothing -> return True + Nothing -> return False Just f - | not (dirCruft f) -> return False + | not (dirCruft f) -> return True | otherwise -> check h diff --git a/Utility/FileIO.hs b/Utility/FileIO.hs new file mode 100644 index 0000000000..4b12b2ba0e --- /dev/null +++ b/Utility/FileIO.hs @@ -0,0 +1,107 @@ +{- File IO on OsPaths. + - + - Since Prelude exports many of these as well, this needs to be imported + - qualified. + - + - Copyright 2025 Joey Hess + - + - License: BSD-2-clause + -} + +{-# OPTIONS_GHC -fno-warn-tabs #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Utility.FileIO +( + withFile, + openFile, + readFile, + readFile', + writeFile, + writeFile', + appendFile, + appendFile', + openTempFile, +) where + +#ifdef WITH_OSPATH + +#ifndef mingw32_HOST_OS +import System.File.OsPath +#else +-- On Windows, System.File.OsPath does not handle UNC-style conversion itself, +-- so that has to be done when calling it. See +-- https://github.com/haskell/file-io/issues/39 +import Utility.Path.Windows +import Utility.OsPath +import System.IO (IO, Handle, IOMode) +import qualified System.File.OsPath as O +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L +import Control.Applicative + +withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withFile f m a = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.withFile f' m a + +openFile :: OsPath -> IOMode -> IO Handle +openFile f m = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.openFile f' m + +readFile :: OsPath -> IO L.ByteString +readFile f = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.readFile f' + +readFile' :: OsPath -> IO B.ByteString +readFile' f = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.readFile' f' + +writeFile :: OsPath -> L.ByteString -> IO () +writeFile f b = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.writeFile f' b + +writeFile' :: OsPath -> B.ByteString -> IO () +writeFile' f b = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.writeFile' f' b + +appendFile :: OsPath -> L.ByteString -> IO () +appendFile f b = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.appendFile f' b + +appendFile' :: OsPath -> B.ByteString -> IO () +appendFile' f b = do + f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f) + O.appendFile' f' b + +openTempFile :: OsPath -> OsPath -> IO (OsPath, Handle) +openTempFile p s = do + p' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath p) + O.openTempFile p' s +#endif + +#else +-- When not building with OsPath, export FilePath versions +-- instead. However, functions still use ByteString for the +-- file content in that case, unlike the Strings used by the Prelude. +import Utility.OsPath +import System.IO (withFile, openFile, openTempFile, IO) +import Data.ByteString.Lazy (readFile, writeFile, appendFile) +import qualified Data.ByteString as B + +readFile' :: OsPath -> IO B.ByteString +readFile' = B.readFile + +writeFile' :: OsPath -> B.ByteString -> IO () +writeFile' = B.writeFile + +appendFile' :: OsPath -> B.ByteString -> IO () +appendFile' = B.appendFile +#endif diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index eb25c526d1..95e5d570ef 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -27,6 +27,8 @@ import Control.Monad.Catch import Utility.Exception import Utility.FileSystemEncoding import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F +import Utility.OsPath {- Applies a conversion function to a file's mode. -} modifyFileMode :: RawFilePath -> (FileMode -> FileMode) -> IO () @@ -178,7 +180,7 @@ writeFileProtected' :: RawFilePath -> (Handle -> IO ()) -> IO () writeFileProtected' file writer = bracket setup cleanup writer where setup = do - h <- protectedOutput $ openFile (fromRawFilePath file) WriteMode + h <- protectedOutput $ F.openFile (toOsPath file) WriteMode void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes return h cleanup = hClose diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs index 3d216f2be4..4858b0bdff 100644 --- a/Utility/FileSize.hs +++ b/Utility/FileSize.hs @@ -17,7 +17,8 @@ module Utility.FileSize ( #ifdef mingw32_HOST_OS import Control.Exception (bracket) import System.IO -import Utility.FileSystemEncoding +import qualified Utility.FileIO as F +import Utility.OsPath #else import System.PosixCompat.Files (fileSize) #endif @@ -36,7 +37,7 @@ getFileSize :: R.RawFilePath -> IO FileSize #ifndef mingw32_HOST_OS getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus f) #else -getFileSize f = bracket (openFile (fromRawFilePath f) ReadMode) hClose hFileSize +getFileSize f = bracket (F.openFile (toOsPath f) ReadMode) hClose hFileSize #endif {- Gets the size of the file, when its FileStatus is already known. diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs index 10c87ca2f3..b4497f30af 100644 --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -33,6 +33,8 @@ import qualified Data.ByteString.Lazy.UTF8 as L8 import qualified GHC.Foreign as GHC import System.IO.Unsafe import Data.ByteString.Unsafe (unsafePackMallocCStringLen) +import Data.Char +import Data.List #endif {- Makes all subsequent Handles that are opened, as well as stdio Handles, @@ -125,26 +127,40 @@ toRawFilePath = encodeFilePath - Avoids returning an invalid part of a unicode byte sequence, at the - cost of efficiency when running on a large FilePath. -} -truncateFilePath :: Int -> FilePath -> FilePath +truncateFilePath :: Int -> RawFilePath -> RawFilePath #ifndef mingw32_HOST_OS -truncateFilePath n = go . reverse +{- On unix, do not assume a unicode locale, but does assume ascii + - characters are a single byte. -} +truncateFilePath n b = + let blen = S.length b + in if blen <= n + then b + else go blen (reverse (fromRawFilePath b)) where - go f = - let b = encodeBS f - in if S.length b <= n - then reverse f - else go (drop 1 f) + go blen f = case uncons f of + Just (c, f') + | isAscii c -> + let blen' = blen - 1 + in if blen' <= n + then toRawFilePath (reverse f') + else go blen' f' + | otherwise -> + let blen' = S.length (toRawFilePath f') + in if blen' <= n + then toRawFilePath (reverse f') + else go blen' f' + Nothing -> toRawFilePath (reverse f) #else {- On Windows, count the number of bytes used by each utf8 character. -} -truncateFilePath n = reverse . go [] n . L8.fromString +truncateFilePath n = toRawFilePath . reverse . go [] n where go coll cnt bs | cnt <= 0 = coll - | otherwise = case L8.decode bs of - Just (c, x) | c /= L8.replacement_char -> + | otherwise = case S8.decode bs of + Just (c, x) | c /= S8.replacement_char -> let x' = fromIntegral x in if cnt - x' < 0 then coll - else go (c:coll) (cnt - x') (L8.drop 1 bs) + else go (c:coll) (cnt - x') (S8.drop 1 bs) _ -> coll #endif diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 19dd7f5395..5fe911528d 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -179,10 +179,10 @@ feedRead cmd params passphrase feeder reader = do go (passphrasefd ++ params) #else -- store the passphrase in a temp file for gpg - withTmpFile "gpg" $ \tmpfile h -> do + withTmpFile (toOsPath "gpg") $ \tmpfile h -> do liftIO $ B.hPutStr h passphrase liftIO $ hClose h - let passphrasefile = [Param "--passphrase-file", File tmpfile] + let passphrasefile = [Param "--passphrase-file", File (fromRawFilePath (fromOsPath tmpfile))] go $ passphrasefile ++ params #endif where diff --git a/Utility/HtmlDetect.hs b/Utility/HtmlDetect.hs index fd5ad2ef06..cf83e52f08 100644 --- a/Utility/HtmlDetect.hs +++ b/Utility/HtmlDetect.hs @@ -13,6 +13,9 @@ module Utility.HtmlDetect ( ) where import Author +import qualified Utility.FileIO as F +import Utility.RawFilePath +import Utility.OsPath import Text.HTML.TagSoup import System.IO @@ -57,8 +60,8 @@ isHtmlBs = isHtml . B8.unpack -- It would be equivalent to use isHtml <$> readFile file, -- but since that would not read all of the file, the handle -- would remain open until it got garbage collected sometime later. -isHtmlFile :: FilePath -> IO Bool -isHtmlFile file = withFile file ReadMode $ \h -> +isHtmlFile :: RawFilePath -> IO Bool +isHtmlFile file = F.withFile (toOsPath file) ReadMode $ \h -> isHtmlBs <$> B.hGet h htmlPrefixLength -- | How much of the beginning of a html document is needed to detect it. diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs index 3828bc645a..6f8008dd5f 100644 --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -185,7 +185,7 @@ readInodeCache s = case words s of (inode:size:mtime:mtimedecimal:_) -> do i <- readish inode sz <- readish size - t <- parsePOSIXTime $ mtime ++ '.' : mtimedecimal + t <- parsePOSIXTime $ encodeBS $ mtime ++ '.' : mtimedecimal return $ InodeCache $ InodeCachePrim i sz (MTimeHighRes t) _ -> Nothing diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs index 55f6998e5e..ec482a1465 100644 --- a/Utility/LinuxMkLibs.hs +++ b/Utility/LinuxMkLibs.hs @@ -18,6 +18,7 @@ module Utility.LinuxMkLibs ( import Utility.PartialPrelude import Utility.Directory +import Utility.SystemDirectory import Utility.Process import Utility.Monad import Utility.Path diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs index be4548b0b6..4ed730ccff 100644 --- a/Utility/LockFile/PidLock.hs +++ b/Utility/LockFile/PidLock.hs @@ -27,6 +27,7 @@ import Utility.PartialPrelude import Utility.Exception import Utility.Applicative import Utility.Directory +import Utility.SystemDirectory import Utility.Monad import Utility.Path.AbsRel import Utility.FileMode @@ -38,6 +39,8 @@ import Utility.FileSystemEncoding import Utility.Env import Utility.Env.Set import Utility.Tmp +import Utility.RawFilePath +import Utility.OsPath import qualified Utility.LockFile.Posix as Posix import System.IO @@ -147,9 +150,10 @@ tryLock lockfile = do _ -> return (Just ParentLocked) where go abslockfile sidelock = do - let abslockfile' = fromRawFilePath abslockfile - (tmp, h) <- openTmpFileIn (takeDirectory abslockfile') "locktmp" - let tmp' = toRawFilePath tmp + (tmp, h) <- openTmpFileIn + (toOsPath (P.takeDirectory abslockfile)) + (toOsPath "locktmp") + let tmp' = fromOsPath tmp setFileMode tmp' (combineModes readModes) hPutStr h . show =<< mkPidLock hClose h @@ -241,15 +245,14 @@ linkToLock (Just _) src dest = do -- with the SAME FILENAME exist. checkInsaneLustre :: RawFilePath -> IO Bool checkInsaneLustre dest = do - let dest' = fromRawFilePath dest - fs <- dirContents (takeDirectory dest') - case length (filter (== dest') fs) of + fs <- dirContents (P.takeDirectory dest) + case length (filter (== dest) fs) of 1 -> return False -- whew! 0 -> return True -- wtf? _ -> do -- Try to clean up the extra copy we made -- that has the same name. Egads. - _ <- tryIO $ removeFile dest' + _ <- tryIO $ removeLink dest return True -- | Waits as necessary to take a lock. diff --git a/Utility/LockFile/Windows.hs b/Utility/LockFile/Windows.hs index c8e7c1bf52..9f35ec1129 100644 --- a/Utility/LockFile/Windows.hs +++ b/Utility/LockFile/Windows.hs @@ -75,9 +75,9 @@ openLock sharemode f = do return $ if h == iNVALID_HANDLE_VALUE then Nothing else Just h -#endif where security_attributes = maybePtr Nothing +#endif dropLock :: LockHandle -> IO () dropLock = closeHandle diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 7c00a184f4..ac98873ab1 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -1,20 +1,24 @@ {- misc utility functions - - - Copyright 2010-2011 Joey Hess + - Copyright 2010-2025 Joey Hess - - License: BSD-2-clause -} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Misc ( hGetContentsStrict, - readFileStrict, separate, separate', separateEnd', firstLine, firstLine', + fileLines, + fileLines', + linesFile, + linesFile', segment, segmentDelim, massReplace, @@ -32,6 +36,9 @@ import Data.List import System.Exit import Control.Applicative import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as L8 import Prelude {- A version of hgetContents that is not lazy. Ensures file is @@ -39,10 +46,6 @@ import Prelude hGetContentsStrict :: Handle -> IO String hGetContentsStrict = hGetContents >=> \s -> length s `seq` return s -{- A version of readFile that is not lazy. -} -readFileStrict :: FilePath -> IO String -readFileStrict = readFile >=> \s -> length s `seq` return s - {- Like break, but the item matching the condition is not included - in the second result list. - @@ -78,6 +81,51 @@ firstLine' = S.takeWhile (/= nl) where nl = fromIntegral (ord '\n') +-- On windows, readFile does NewlineMode translation, +-- stripping CR before LF. When converting to ByteString, +-- use this to emulate that. +fileLines :: L.ByteString -> [L.ByteString] +#ifdef mingw32_HOST_OS +fileLines = map stripCR . L8.lines + where + stripCR b = case L8.unsnoc b of + Nothing -> b + Just (b', e) + | e == '\r' -> b' + | otherwise -> b +#else +fileLines = L8.lines +#endif + +fileLines' :: S.ByteString -> [S.ByteString] +#ifdef mingw32_HOST_OS +fileLines' = map stripCR . S8.lines + where + stripCR b = case S8.unsnoc b of + Nothing -> b + Just (b', e) + | e == '\r' -> b' + | otherwise -> b +#else +fileLines' = S8.lines +#endif + +-- One windows, writeFile does NewlineMode translation, +-- adding CR before LF. When converting to ByteString, use this to emulate that. +linesFile :: L.ByteString -> L.ByteString +#ifndef mingw32_HOST_OS +linesFile = id +#else +linesFile = L8.concat . concatMap (\x -> [x, L8.pack "\r\n"]) . fileLines +#endif + +linesFile' :: S.ByteString -> S.ByteString +#ifndef mingw32_HOST_OS +linesFile' = id +#else +linesFile' = S8.concat . concatMap (\x -> [x, S8.pack "\r\n"]) . fileLines' +#endif + {- Splits a list into segments that are delimited by items matching - a predicate. (The delimiters are not included in the segments.) - Segments may be empty. -} diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs index 1609c85109..d80c9203f8 100644 --- a/Utility/MoveFile.hs +++ b/Utility/MoveFile.hs @@ -28,6 +28,7 @@ import Utility.Tmp import Utility.Exception import Utility.Monad import Utility.FileSystemEncoding +import Utility.OsPath import qualified Utility.RawFilePath as R import Author @@ -40,11 +41,12 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename onrename (Left e) | isPermissionError e = rethrow | isDoesNotExistError e = rethrow - | otherwise = viaTmp mv (fromRawFilePath dest) () + | otherwise = viaTmp mv (toOsPath dest) () where rethrow = throwM e mv tmp () = do + let tmp' = fromRawFilePath (fromOsPath tmp) -- copyFile is likely not as optimised as -- the mv command, so we'll use the command. -- @@ -57,18 +59,18 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename ok <- copyright =<< boolSystem "mv" [ Param "-f" , Param (fromRawFilePath src) - , Param tmp + , Param tmp' ] let e' = e #else - r <- tryIO $ copyFile (fromRawFilePath src) tmp + r <- tryIO $ copyFile (fromRawFilePath src) tmp' let (ok, e') = case r of Left err -> (False, err) Right _ -> (True, e) #endif unless ok $ do -- delete any partial - _ <- tryIO $ removeFile tmp + _ <- tryIO $ removeFile tmp' throwM e' #ifndef mingw32_HOST_OS diff --git a/Utility/OsPath.hs b/Utility/OsPath.hs new file mode 100644 index 0000000000..59302cd53e --- /dev/null +++ b/Utility/OsPath.hs @@ -0,0 +1,65 @@ +{- OsPath utilities + - + - Copyright 2025 Joey Hess + - + - License: BSD-2-clause + -} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE PackageImports #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.OsPath ( + OsPath, + OsString, + toOsPath, + fromOsPath, +) where + +import Utility.FileSystemEncoding + +#ifdef WITH_OSPATH +import System.OsPath +import "os-string" System.OsString.Internal.Types +import qualified Data.ByteString.Short as S +#if defined(mingw32_HOST_OS) +import GHC.IO (unsafePerformIO) +import System.OsString.Encoding.Internal (cWcharsToChars_UCS2) +import qualified System.OsString.Data.ByteString.Short.Word16 as BS16 +#endif + +toOsPath :: RawFilePath -> OsPath +#if defined(mingw32_HOST_OS) +-- On Windows, OsString contains a ShortByteString that is +-- utf-16 encoded. So have to convert the input to that. +-- This is relatively expensive. +toOsPath = unsafePerformIO . encodeFS . fromRawFilePath +#else +toOsPath = OsString . PosixString . S.toShort +#endif + +fromOsPath :: OsPath -> RawFilePath +#if defined(mingw32_HOST_OS) +-- On Windows, OsString contains a ShortByteString that is +-- utf-16 encoded. So have to convert the input from that. +-- This is relatively expensive. +fromOsPath = toRawFilePath . cWcharsToChars_UCS2 . BS16.unpack . getWindowsString . getOsString +#else +fromOsPath = S.fromShort . getPosixString . getOsString +#endif + +#else +{- When not building with WITH_OSPATH, use FilePath. This allows + - using functions from legacy FilePath libraries interchangeably with + - newer OsPath libraries. + -} +type OsPath = FilePath + +type OsString = String + +toOsPath :: RawFilePath -> OsPath +toOsPath = fromRawFilePath + +fromOsPath :: OsPath -> RawFilePath +fromOsPath = toRawFilePath +#endif diff --git a/Utility/SshConfig.hs b/Utility/SshConfig.hs index 83c63fcd3d..fb7a6b95ac 100644 --- a/Utility/SshConfig.hs +++ b/Utility/SshConfig.hs @@ -28,11 +28,13 @@ import Common import Utility.UserInfo import Utility.Tmp import Utility.FileMode +import qualified Utility.FileIO as F import Data.Char import Data.Ord import Data.Either import System.PosixCompat.Files (groupWriteMode, otherWriteMode) +import qualified Data.ByteString.Char8 as S8 data SshConfig = GlobalConfig SshSetting @@ -134,18 +136,19 @@ changeUserSshConfig modifier = do sshdir <- sshDir let configfile = sshdir "config" whenM (doesFileExist configfile) $ do - c <- readFileStrict configfile + c <- decodeBS . S8.unlines . fileLines' + <$> F.readFile' (toOsPath (toRawFilePath configfile)) let c' = modifier c when (c /= c') $ do -- If it's a symlink, replace the file it -- points to. f <- catchDefaultIO configfile (canonicalizePath configfile) - viaTmp writeSshConfig f c' + viaTmp writeSshConfig (toOsPath (toRawFilePath f)) c' -writeSshConfig :: FilePath -> String -> IO () +writeSshConfig :: OsPath -> String -> IO () writeSshConfig f s = do - writeFile f s - setSshConfigMode (toRawFilePath f) + F.writeFile' f (linesFile' (encodeBS s)) + setSshConfigMode (fromOsPath f) {- Ensure that the ssh config file lacks any group or other write bits, - since ssh is paranoid about not working if other users can write diff --git a/Utility/StatelessOpenPGP.hs b/Utility/StatelessOpenPGP.hs index 2915d51015..205fa91ff8 100644 --- a/Utility/StatelessOpenPGP.hs +++ b/Utility/StatelessOpenPGP.hs @@ -112,7 +112,7 @@ decryptSymmetric sopcmd password emptydirectory feeder reader = {- Test a value round-trips through symmetric encryption and decryption. -} test_encrypt_decrypt_Symmetric :: SOPCmd -> SOPCmd -> Password -> Armoring -> B.ByteString -> IO Bool test_encrypt_decrypt_Symmetric a b password armoring v = catchBoolIO $ - withTmpDir "test" $ \d -> do + withTmpDir (toOsPath "test") $ \d -> do let ed = EmptyDirectory d enc <- encryptSymmetric a password ed Nothing armoring (`B.hPutStr` v) B.hGetContents @@ -159,10 +159,10 @@ feedRead cmd subcmd params password emptydirectory feeder reader = do go (Just emptydirectory) (passwordfd ++ params) #else -- store the password in a temp file - withTmpFile "sop" $ \tmpfile h -> do + withTmpFile (toOsPath "sop") $ \tmpfile h -> do liftIO $ B.hPutStr h password liftIO $ hClose h - let passwordfile = [Param $ "--with-password="++tmpfile] + let passwordfile = [Param $ "--with-password=" ++ fromRawFilePath (fromOsPath tmpfile)] -- Don't need to pass emptydirectory since @FD is not used, -- and so tmpfile also does not need to be made absolute. case emptydirectory of diff --git a/Utility/TimeStamp.hs b/Utility/TimeStamp.hs index 878d6f7299..1175034e91 100644 --- a/Utility/TimeStamp.hs +++ b/Utility/TimeStamp.hs @@ -19,7 +19,6 @@ import Data.Time import Data.Ratio import Control.Applicative import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 import qualified Data.Attoparsec.ByteString as A import Data.Attoparsec.ByteString.Char8 (char, decimal, signed, isDigit_w8) @@ -41,9 +40,9 @@ parserPOSIXTime = mkPOSIXTime A.parseOnly (decimal <* A.endOfInput) b return (d, len) -parsePOSIXTime :: String -> Maybe POSIXTime -parsePOSIXTime s = eitherToMaybe $ - A.parseOnly (parserPOSIXTime <* A.endOfInput) (B8.pack s) +parsePOSIXTime :: B.ByteString -> Maybe POSIXTime +parsePOSIXTime b = eitherToMaybe $ + A.parseOnly (parserPOSIXTime <* A.endOfInput) b {- This implementation allows for higher precision in a POSIXTime than - supported by the system's Double, and avoids the complications of diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index a23a2a37f5..8e0ca10755 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -1,11 +1,11 @@ {- Temporary files. - - - Copyright 2010-2020 Joey Hess + - Copyright 2010-2025 Joey Hess - - License: BSD-2-clause -} -{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Tmp ( @@ -13,33 +13,38 @@ module Utility.Tmp ( viaTmp, withTmpFile, withTmpFileIn, - relatedTemplate, openTmpFileIn, + relatedTemplate, + relatedTemplate', ) where import System.IO -import System.FilePath import System.Directory import Control.Monad.IO.Class import System.IO.Error +import Data.Char +import qualified Data.ByteString as B +import qualified System.FilePath.ByteString as P import Utility.Exception import Utility.FileSystemEncoding import Utility.FileMode import qualified Utility.RawFilePath as R +import qualified Utility.FileIO as F +import Utility.OsPath -type Template = String +type Template = OsString {- This is the same as openTempFile, except when there is an - error, it displays the template as well as the directory, - to help identify what call was responsible. -} -openTmpFileIn :: FilePath -> String -> IO (FilePath, Handle) -openTmpFileIn dir template = openTempFile dir template +openTmpFileIn :: OsPath -> Template -> IO (OsPath, Handle) +openTmpFileIn dir template = F.openTempFile dir template `catchIO` decoraterrror where decoraterrror e = throwM $ - let loc = ioeGetLocation e ++ " template " ++ template + let loc = ioeGetLocation e ++ " template " ++ decodeBS (fromOsPath template) in annotateIOError e loc Nothing Nothing {- Runs an action like writeFile, writing to a temp file first and @@ -50,34 +55,36 @@ openTmpFileIn dir template = openTempFile dir template - mode as it would when using writeFile, unless the writer action changes - it. -} -viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m () +viaTmp :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m () viaTmp a file content = bracketIO setup cleanup use where - (dir, base) = splitFileName file - template = relatedTemplate (base ++ ".tmp") + (dir, base) = P.splitFileName (fromOsPath file) + template = relatedTemplate (base <> ".tmp") setup = do - createDirectoryIfMissing True dir - openTmpFileIn dir template + createDirectoryIfMissing True (fromRawFilePath dir) + openTmpFileIn (toOsPath dir) template cleanup (tmpfile, h) = do _ <- tryIO $ hClose h - tryIO $ removeFile tmpfile + tryIO $ R.removeLink (fromOsPath tmpfile) use (tmpfile, h) = do - let tmpfile' = toRawFilePath tmpfile + let tmpfile' = fromOsPath tmpfile -- Make mode the same as if the file were created usually, -- not as a temp file. (This may fail on some filesystems -- that don't support file modes well, so ignore -- exceptions.) - _ <- liftIO $ tryIO $ R.setFileMode tmpfile' =<< defaultFileMode + _ <- liftIO $ tryIO $ + R.setFileMode (fromOsPath tmpfile) + =<< defaultFileMode liftIO $ hClose h a tmpfile content - liftIO $ R.rename tmpfile' (toRawFilePath file) + liftIO $ R.rename tmpfile' (fromOsPath file) {- Runs an action with a tmp file located in the system's tmp directory - (or in "." if there is none) then removes the file. -} -withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a +withTmpFile :: (MonadIO m, MonadMask m) => Template -> (OsPath -> Handle -> m a) -> m a withTmpFile template a = do tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory - withTmpFileIn tmpdir template a + withTmpFileIn (toOsPath (toRawFilePath tmpdir)) template a {- Runs an action with a tmp file located in the specified directory, - then removes the file. @@ -85,13 +92,13 @@ withTmpFile template a = do - Note that the tmp file will have a file mode that only allows the - current user to access it. -} -withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a +withTmpFileIn :: (MonadIO m, MonadMask m) => OsPath -> Template -> (OsPath -> Handle -> m a) -> m a withTmpFileIn tmpdir template a = bracket create remove use where create = liftIO $ openTmpFileIn tmpdir template remove (name, h) = liftIO $ do hClose h - catchBoolIO (removeFile name >> return True) + tryIO $ R.removeLink (fromOsPath name) use (name, h) = a name h {- It's not safe to use a FilePath of an existing file as the template @@ -99,18 +106,29 @@ withTmpFileIn tmpdir template a = bracket create remove use - will be longer, and may exceed the maximum filename length. - - This generates a template that is never too long. - - (Well, it allocates 20 characters for use in making a unique temp file, - - anyway, which is enough for the current implementation and any - - likely implementation.) -} -relatedTemplate :: FilePath -> FilePath -relatedTemplate f - | len > 20 = +relatedTemplate :: RawFilePath -> Template +relatedTemplate = toOsPath . relatedTemplate' + +relatedTemplate' :: RawFilePath -> RawFilePath +relatedTemplate' f + | len > templateAddedLength = {- Some filesystems like FAT have issues with filenames - ending in ".", so avoid truncating a filename to end - that way. -} - reverse $ dropWhile (== '.') $ reverse $ - truncateFilePath (len - 20) f + B.dropWhileEnd (== dot) $ + truncateFilePath (len - templateAddedLength) f | otherwise = f where - len = length f + len = B.length f + dot = fromIntegral (ord '.') + +{- When a Template is used to create a temporary file, some random bytes + - are appended to it. This is how many such bytes can be added, maximum. + - + - This needs to be as long or longer than the current implementation + - of openTempFile, and some extra has been added to make it longer + - than any likely implementation. + -} +templateAddedLength :: Int +templateAddedLength = 20 diff --git a/Utility/Tmp/Dir.hs b/Utility/Tmp/Dir.hs index 904b65a526..c359b9d82d 100644 --- a/Utility/Tmp/Dir.hs +++ b/Utility/Tmp/Dir.hs @@ -23,6 +23,8 @@ import System.Posix.Temp (mkdtemp) import Utility.Exception import Utility.Tmp (Template) +import Utility.OsPath +import Utility.FileSystemEncoding {- Runs an action with a tmp directory located within the system's tmp - directory (or within "." if there is none), then removes the tmp @@ -33,7 +35,7 @@ withTmpDir template a = do #ifndef mingw32_HOST_OS -- Use mkdtemp to create a temp directory securely in /tmp. bracket - (liftIO $ mkdtemp $ topleveltmpdir template) + (liftIO $ mkdtemp $ topleveltmpdir fromRawFilePath (fromOsPath template)) removeTmpDir a #else @@ -47,7 +49,7 @@ withTmpDirIn tmpdir template = bracketIO create removeTmpDir where create = do createDirectoryIfMissing True tmpdir - makenewdir (tmpdir template) (0 :: Int) + makenewdir (tmpdir fromRawFilePath (fromOsPath template)) (0 :: Int) makenewdir t n = do let dir = t ++ "." ++ show n catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 987d67cbd6..937b3bad5a 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -187,7 +187,9 @@ insertAuthToken extractAuthToken predicate webapp root pathbits params = - to avoid exposing the secret token when launching the web browser. -} writeHtmlShim :: String -> String -> FilePath -> IO () writeHtmlShim title url file = - viaTmp (writeFileProtected . toRawFilePath) file $ genHtmlShim title url + viaTmp (writeFileProtected . fromOsPath) + (toOsPath $ toRawFilePath file) + (genHtmlShim title url) genHtmlShim :: String -> String -> String genHtmlShim title url = unlines diff --git a/git-annex.cabal b/git-annex.cabal index 864efa527e..b610cdf65c 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -175,6 +175,9 @@ Flag Crypton Flag Servant Description: Use the servant library, enabling using annex+http urls and git-annex p2phttp +Flag OsPath + Description: Use the os-string library and related libraries, for faster filename manipulation + Flag Benchmark Description: Enable benchmarking Default: True @@ -329,6 +332,16 @@ Executable git-annex P2P.Http.Server P2P.Http.State + if flag(OsPath) + -- Currently this build flag does not pass the test suite on Windows + if (! os(windows)) + Build-Depends: + os-string (>= 2.0.0), + directory (>= 1.3.8.3), + filepath (>= 1.5.2.0), + file-io (>= 0.1.3) + CPP-Options: -DWITH_OSPATH + if (os(windows)) Build-Depends: Win32 ((>= 2.6.1.0 && < 2.12.0.0) || >= 2.13.4.0), @@ -1094,6 +1107,7 @@ Executable git-annex Utility.OpenFile Utility.OptParse Utility.OSX + Utility.OsPath Utility.PID Utility.PartialPrelude Utility.Path @@ -1123,6 +1137,7 @@ Executable git-annex Utility.STM Utility.Su Utility.SystemDirectory + Utility.FileIO Utility.Terminal Utility.TimeStamp Utility.TList diff --git a/stack.yaml b/stack.yaml index d46045734f..5ff6f33d09 100644 --- a/stack.yaml +++ b/stack.yaml @@ -11,8 +11,15 @@ flags: benchmark: true crypton: true servant: true + ospath: true packages: - '.' -resolver: lts-23.2 +resolver: nightly-2025-01-20 extra-deps: -- filepath-bytestring-1.4.100.3.2 +- filepath-bytestring-1.5.2.0.2 +- aws-0.24.4 +- git-lfs-1.2.3 +- feed-1.3.2.1 +allow-newer: true +allow-newer-deps: +- feed From 9a5fbcc9425eb0a4b6c45f7c2961558ba820e320 Mon Sep 17 00:00:00 2001 From: jnkl Date: Thu, 30 Jan 2025 18:35:55 +0000 Subject: [PATCH 10/15] --- doc/forum/__34__--fast__34___option_for_git_annex_get__63__.mdwn | 1 + 1 file changed, 1 insertion(+) create mode 100644 doc/forum/__34__--fast__34___option_for_git_annex_get__63__.mdwn diff --git a/doc/forum/__34__--fast__34___option_for_git_annex_get__63__.mdwn b/doc/forum/__34__--fast__34___option_for_git_annex_get__63__.mdwn new file mode 100644 index 0000000000..38fc6610ae --- /dev/null +++ b/doc/forum/__34__--fast__34___option_for_git_annex_get__63__.mdwn @@ -0,0 +1 @@ +What does the ```--fast``` option in ```git annex get -A --fast``` do? From 3a08881214541b483a710f88a95db7dc169d4150 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Jan 2025 14:49:38 -0400 Subject: [PATCH 11/15] avoid build warnings on windows --- Annex/Proxy.hs | 8 +++++++- Test.hs | 4 ++-- Utility/MoveFile.hs | 2 +- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs index 6fb739b30c..fe11be06b3 100644 --- a/Annex/Proxy.hs +++ b/Annex/Proxy.hs @@ -40,12 +40,14 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Concurrent.Async import qualified Data.ByteString as B -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as L import qualified System.FilePath.ByteString as P import qualified Data.Map as M import qualified Data.Set as S +#ifndef mingw32_HOST_OS +import qualified Data.ByteString as BS import System.IO.Unsafe +#endif proxyRemoteSide :: ProtocolVersion -> Bypass -> Remote -> Annex RemoteSide proxyRemoteSide clientmaxversion bypass r @@ -262,7 +264,11 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go proxyget offset af k = withproxytmpfile k $ \tmpfile -> do let retrieve = tryNonAsync $ Remote.retrieveKeyFile r k af (fromRawFilePath tmpfile) nullMeterUpdate vc +#ifndef mingw32_HOST_OS ordered <- Remote.retrieveKeyFileInOrder r +#else + _ <- Remote.retrieveKeyFileInOrder r +#endif case fromKey keySize k of #ifndef mingw32_HOST_OS Just size | size > 0 && ordered -> do diff --git a/Test.hs b/Test.hs index 6c231c9859..2bc999d0f2 100644 --- a/Test.hs +++ b/Test.hs @@ -37,9 +37,9 @@ import qualified Git.Types import qualified Git.Ref import qualified Git.LsTree import qualified Git.FilePath -import qualified Git.Bundle import qualified Annex.Locations #ifndef mingw32_HOST_OS +import qualified Git.Bundle import qualified Types.GitConfig #endif import qualified Types.TrustLevel @@ -452,7 +452,7 @@ test_git_remote_annex exporttree git_annex "get" [annexedfile] "get from origin special remote" diruuid="89ddefa4-a04c-11ef-87b5-e880882a4f98" #else -test_git_remote_annex exporttree = +test_git_remote_annex _exporttree = -- git-remote-annex is not currently installed on Windows return () #endif diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs index d80c9203f8..12b02cbd81 100644 --- a/Utility/MoveFile.hs +++ b/Utility/MoveFile.hs @@ -79,7 +79,7 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename case r of (Left _) -> return False (Right s) -> return $ isDirectory s +#endif copyright :: Copyright copyright = author JoeyHess (2022-11) -#endif From c681d3fef6ecc619dd049e2ea09e8ca4985b4e1a Mon Sep 17 00:00:00 2001 From: jnkl Date: Thu, 30 Jan 2025 18:52:14 +0000 Subject: [PATCH 12/15] Added a comment --- .../comment_6_8a4ac94a9184f7ab275ba246489323c3._comment | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_6_8a4ac94a9184f7ab275ba246489323c3._comment diff --git a/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_6_8a4ac94a9184f7ab275ba246489323c3._comment b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_6_8a4ac94a9184f7ab275ba246489323c3._comment new file mode 100644 index 0000000000..963254acf2 --- /dev/null +++ b/doc/forum/Deduplication_between_two_repos_on_the_same_drive__63__/comment_6_8a4ac94a9184f7ab275ba246489323c3._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="jnkl" + avatar="http://cdn.libravatar.org/avatar/2ab576f3bf2e0d96b1ee935bb7f33dbe" + subject="comment 6" + date="2025-01-30T18:52:14Z" + content=""" +Thank you! +"""]] From c926de73b9b5335acb9623fd6be41691f8612d07 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Jan 2025 14:52:41 -0400 Subject: [PATCH 13/15] avoid build warning An odd one, it complained about security_attributes being defined but not used, but it was used.. --- Utility/LockFile/Windows.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Utility/LockFile/Windows.hs b/Utility/LockFile/Windows.hs index 9f35ec1129..8e6c6d2905 100644 --- a/Utility/LockFile/Windows.hs +++ b/Utility/LockFile/Windows.hs @@ -70,13 +70,11 @@ openLock sharemode f = do Right h -> Just h #else h <- withTString (fromRawFilePath f') $ \c_f -> - c_CreateFile c_f gENERIC_READ sharemode security_attributes + c_CreateFile c_f gENERIC_READ sharemode (maybePtr Nothing) oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL (maybePtr Nothing) return $ if h == iNVALID_HANDLE_VALUE then Nothing else Just h - where - security_attributes = maybePtr Nothing #endif dropLock :: LockHandle -> IO () From 9f5393016f0b20be3ca8d8070764b05f43683a06 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Jan 2025 14:57:51 -0400 Subject: [PATCH 14/15] response --- ...ment_1_276bf7e33acbc8b633be799b03c49d82._comment | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 doc/forum/__34__--fast__34___option_for_git_annex_get__63__/comment_1_276bf7e33acbc8b633be799b03c49d82._comment diff --git a/doc/forum/__34__--fast__34___option_for_git_annex_get__63__/comment_1_276bf7e33acbc8b633be799b03c49d82._comment b/doc/forum/__34__--fast__34___option_for_git_annex_get__63__/comment_1_276bf7e33acbc8b633be799b03c49d82._comment new file mode 100644 index 0000000000..adc7ac4f0a --- /dev/null +++ b/doc/forum/__34__--fast__34___option_for_git_annex_get__63__/comment_1_276bf7e33acbc8b633be799b03c49d82._comment @@ -0,0 +1,13 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2025-01-30T18:56:04Z" + content=""" +Nothing. --fast happens to be parsed as a global option so it's +accepted with every command, but it does not change the usual behavior of +`git-annex get` at all. + +Commands like `git-annex copy` +that implement a different behavior for --fast have it documented +in their individual man pages. +"""]] From 4ceb00d0dcf8cfdb95481e240ebddf63bcb1506e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Jan 2025 15:02:59 -0400 Subject: [PATCH 15/15] update appveyor cache directory With old: Cache entry not found: C:\projects\git-annex\Users\appveyor\.stack I think fixing this will result in caching preventing a full rebuild of git-annex each time. --- .appveyor.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.appveyor.yml b/.appveyor.yml index 2525c11167..b2a518e917 100644 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -73,7 +73,7 @@ skip_commits: cache: - C:\sr -> stack.yaml - C:\Users\appveyor\AppData\Local\Programs\stack -> stack.yaml - - /Users/appveyor/.stack -> stack.yaml + - C:\projects\git-annex\.stack-work -> stack.yaml # turn of support for MS project build support (not needed) build: off