Lock package directories with lock-files (fixes #957)

src/fpm.f90

@@ -9,6 +9,7 @@ module fpm
 use fpm_dependency, only : new_dependency_tree
 use fpm_filesystem, only: is_dir, join_path, list_files, exists, &
                    basename, filewrite, mkdir, run, os_delete_dir
+use fpm_lock, only: fpm_lock_acquire, fpm_lock_release
 use fpm_model, only: fpm_model_t, srcfile_t, show_model, fortran_features_t, &
                     FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
                     FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST
@@ -436,6 +437,11 @@ subroutine cmd_build(settings)
 
 integer :: i
 
+call fpm_lock_acquire(error)
+if (allocated(error)) then
+    call fpm_stop(1, '*cmd_build* Lock error: '//error%message)
+end if
+
 call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
 if (allocated(error)) then
     call fpm_stop(1,'*cmd_build* Package error: '//error%message)
@@ -467,6 +473,11 @@ subroutine cmd_build(settings)
     call build_package(targets,model,verbose=settings%verbose)
 endif
 
+call fpm_lock_release(error)
+if (allocated(error)) then
+    call fpm_stop(1, '*cmd_build* Lock error: '//error%message)
+end if
+
 end subroutine cmd_build
 
 subroutine cmd_run(settings,test)
@@ -487,6 +498,11 @@ subroutine cmd_run(settings,test)
     integer, allocatable :: stat(:),target_ID(:)
     character(len=:),allocatable :: line
 
+    call fpm_lock_acquire(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_run* Lock error: '//error%message)
+    end if
+
     call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
     if (allocated(error)) then
         call fpm_stop(1, '*cmd_run* Package error: '//error%message)
@@ -616,6 +632,11 @@ subroutine cmd_run(settings,test)
 
     end if
 
+    call fpm_lock_release(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_run* Lock error: '//error%message)
+    end if
+
     contains
 
     subroutine compact_list_all()
@@ -684,6 +705,11 @@ subroutine cmd_clean(settings)
     type(fpm_global_settings) :: global_settings
     type(error_t), allocatable :: error
 
+    call fpm_lock_acquire(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_clean* Lock error: '//error%message)
+    end if
+
     ! Clear registry cache
     if (settings%registry_cache) then
         call get_global_settings(global_settings, error) 
@@ -708,6 +734,11 @@ subroutine cmd_clean(settings)
     else
         write (stdout, '(A)') "fpm: No build directory found."
     end if
+
+    call fpm_lock_release(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_clean* Lock error: '//error%message)
+     end if
 end subroutine cmd_clean
 
 !> Sort executables by namelist ID, and trim unused values

src/fpm/cmd/export.f90

@@ -3,6 +3,7 @@ module fpm_cmd_export
   use fpm_dependency, only : dependency_tree_t, new_dependency_tree
   use fpm_error, only : error_t, fpm_stop
   use fpm_filesystem, only : join_path
+  use fpm_lock, only : fpm_lock_acquire, fpm_lock_release
   use fpm_manifest, only : package_config_t, get_package_data
   use fpm_toml, only: name_is_json
   use fpm_model, only: fpm_model_t
@@ -25,6 +26,9 @@ subroutine cmd_export(settings)
     integer :: ii
     character(len=:), allocatable :: filename
 
+    call fpm_lock_acquire(error)
+    call handle_error(error)
+
     if (len_trim(settings%dump_manifest)<=0 .and. &
         len_trim(settings%dump_model)<=0 .and. &
         len_trim(settings%dump_dependencies)<=0) then
@@ -69,6 +73,9 @@ subroutine cmd_export(settings)
         call handle_error(error)
     end if
 
+    call fpm_lock_release(error)
+    call handle_error(error)
+
   end subroutine cmd_export
 
   !> Error handling for this command

src/fpm/cmd/install.f90

@@ -5,6 +5,7 @@ module fpm_cmd_install
   use fpm_command_line, only : fpm_install_settings
   use fpm_error, only : error_t, fatal_error, fpm_stop
   use fpm_filesystem, only : join_path, list_files
+  use fpm_lock, only : fpm_lock_acquire, fpm_lock_release
   use fpm_installer, only : installer_t, new_installer
   use fpm_manifest, only : package_config_t, get_package_data
   use fpm_model, only : fpm_model_t, FPM_SCOPE_APP, FPM_SCOPE_TEST
@@ -32,6 +33,9 @@ subroutine cmd_install(settings)
     logical :: installable
     integer :: ntargets
 
+    call fpm_lock_acquire(error)
+    call handle_error(error)
+
     call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
     call handle_error(error)
 
@@ -85,6 +89,9 @@ subroutine cmd_install(settings)
 
     end if
 
+  call fpm_lock_release(error)
+  call handle_error(error)
+
   end subroutine cmd_install
 
   subroutine install_info(unit, verbose, targets, ntargets)

src/fpm/cmd/publish.f90

@@ -4,6 +4,7 @@
 !> The token can be obtained from the registry website. It can be used as `fpm publish --token <token>`.
 module fpm_cmd_publish
   use fpm_command_line, only: fpm_publish_settings
+  use fpm_lock, only : fpm_lock_acquire, fpm_lock_release
   use fpm_manifest, only: package_config_t, get_package_data
   use fpm_model, only: fpm_model_t
   use fpm_error, only: error_t, fpm_stop
@@ -35,6 +36,11 @@ subroutine cmd_publish(settings)
     type(downloader_t) :: downloader
     integer :: i
 
+    call fpm_lock_acquire(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_publish* Lock error: '//error%message)
+    end if
+
     ! Get package data to determine package version.
     call get_package_data(package, 'fpm.toml', error, apply_defaults=.true.)
     if (allocated(error)) call fpm_stop(1, '*cmd_build* Package error: '//error%message)
@@ -106,6 +112,12 @@ subroutine cmd_publish(settings)
     call downloader%upload_form(official_registry_base_url//'/packages', upload_data, settings%verbose, error)
     call delete_file(tmp_file)
     if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message)
+
+    call fpm_lock_release(error)
+    if (allocated(error)) then
+        call fpm_stop(1, '*cmd_publish* Lock error: '//error%message)
+    end if
+
   end
 
   subroutine print_upload_data(upload_data)

src/fpm/cmd/update.f90

@@ -3,6 +3,7 @@ module fpm_cmd_update
   use fpm_dependency, only : dependency_tree_t, new_dependency_tree
   use fpm_error, only : error_t, fpm_stop
   use fpm_filesystem, only : exists, mkdir, join_path, delete_file, filewrite
+  use fpm_lock, only : fpm_lock_acquire, fpm_lock_release
   use fpm_manifest, only : package_config_t, get_package_data
   use fpm_toml, only: name_is_json
   implicit none
@@ -22,6 +23,9 @@ subroutine cmd_update(settings)
     integer :: ii
     character(len=:), allocatable :: cache
 
+    call fpm_lock_acquire(error)
+    call handle_error(error)
+
     call get_package_data(package, "fpm.toml", error, apply_defaults=.true.)
     call handle_error(error)
 
@@ -63,6 +67,9 @@ subroutine cmd_update(settings)
         call handle_error(error)
     end if
 
+    call fpm_lock_release(error)
+    call handle_error(error)
+
   end subroutine cmd_update
 
   !> Error handling for this command

src/fpm_lock.c

@@ -0,0 +1,88 @@
+#include <errno.h>
+#include <fcntl.h>
+#include <string.h>
+#include <stdlib.h>
+
+#ifndef _WIN32
+
+#include <unistd.h>
+
+#else
+
+#include <io.h>
+#include <sys\stat.h>
+
+#define open _open
+
+#endif
+
+// @brief A thread-safe version of strerror using malloc.
+// @param errnum
+char *my_strerror(int errnum) {
+    const int BUFSIZE = 256;
+    char *buf = malloc(BUFSIZE);
+
+// POSIX strerror_r and Windows strerror_s are both thread-safe versions of
+// strerror with the same interface except for the order of the arguments.
+#ifndef _WIN32
+    int stat = strerror_r(errnum, buf, BUFSIZE);
+#else
+    int stat = strerror_s(buf, BUFSIZE, errnum);
+#endif
+    if (stat != 0) {
+        const char *MSG = "Unknown error";
+        memcpy(buf, MSG, strlen(MSG));
+    }
+
+    return buf;
+}
+
+/// @brief Create a file if it doesn't already exist in an atomic manner.
+/// @param path
+/// @param iostat Zero if file was successfully created, nonzero otherwise.
+/// @param iomsg Points to an error message if an error occurred, NULL otherwise.
+/// @param exsits Zero if the file didn't exist already, nonzero otherwise.
+void c_create(char *path, int *iostat, char **iomsg, int *exists) {
+    int fd = open(path,
+                  O_RDONLY | O_CREAT | O_EXCL,
+                  S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH);
+
+    if (fd == -1 && errno != EEXIST) {  // Some unexpected error occurred.
+        *iostat = 1;
+        *iomsg = my_strerror(errno);
+        return;
+    }
+
+    if (fd == -1 && errno == EEXIST) {  // The lock-file already exists.
+        *exists = 1;
+    }
+
+    if (fd != -1) {  // The lock-file was created.
+        *exists = 0;
+
+        int stat = close(fd);
+        if (stat == -1) {
+            *iostat = 1;
+            *iomsg = my_strerror(errno);
+            return;
+        }
+    }
+
+    *iostat = 0;
+    *iomsg = NULL;
+}
+
+// @brief Remove a file/directory in an atomic manner.
+// @param path
+// @param iostat
+// @param iomsg
+void c_remove(char *path, int *iostat, char **iomsg) {
+    int stat = remove(path);
+    if (stat == -1) {
+        *iostat = 1;
+        *iomsg = my_strerror(errno);
+        return;
+    }
+    *iostat = 0;
+    *iomsg = NULL;
+}