Implement fpm publish

app/main.f90

@@ -9,13 +9,15 @@ program main
         fpm_install_settings, &
         fpm_update_settings, &
         fpm_clean_settings, &
+        fpm_publish_settings, &
         get_command_line_settings
 use fpm_error, only: error_t
 use fpm_filesystem, only: exists, parent_dir, join_path
 use fpm, only: cmd_build, cmd_run, cmd_clean
 use fpm_cmd_install, only: cmd_install
 use fpm_cmd_new, only: cmd_new
 use fpm_cmd_update, only : cmd_update
+use fpm_cmd_publish, only: cmd_publish
 use fpm_os,  only: change_directory, get_current_directory
 
 implicit none
@@ -80,6 +82,8 @@ program main
     call cmd_update(settings)
 type is (fpm_clean_settings)
     call cmd_clean(settings)
+type is (fpm_publish_settings)
+    call cmd_publish(settings)
 end select
 
 if (allocated(project_root)) then

fpm.toml

@@ -11,11 +11,11 @@ macros=["FPM_RELEASE_VERSION={version}"]
 
 [dependencies]
 toml-f.git = "https://github.com/toml-f/toml-f"
-toml-f.rev = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f"
+toml-f.rev = "d7b892b1d074b7cfc5d75c3e0eb36ebc1f7958c1"
 M_CLI2.git = "https://github.com/urbanjost/M_CLI2.git"
 M_CLI2.rev = "7264878cdb1baff7323cc48596d829ccfe7751b8"
 jonquil.git = "https://github.com/toml-f/jonquil"
-jonquil.rev = "05d30818bb12fb877226ce284b9a3a41b971a889"
+jonquil.rev = "4c27c8c1e411fa8790dffcf8c3fa7a27b6322273"
 
 [[test]]
 name = "cli-test"

src/fpm.f90

@@ -7,7 +7,6 @@ module fpm
                       fpm_run_settings, fpm_install_settings, fpm_test_settings, &
                       fpm_clean_settings
 use fpm_dependency, only : new_dependency_tree
-use fpm_environment, only: get_env
 use fpm_filesystem, only: is_dir, join_path, list_files, exists, &
                    basename, filewrite, mkdir, run, os_delete_dir
 use fpm_model, only: fpm_model_t, srcfile_t, show_model, fortran_features_t, &

src/fpm/cmd/publish.f90

@@ -0,0 +1,86 @@
+!> Upload a package to the registry using the `publish` command.
+!>
+!> To upload a package you need to provide a token that will be linked to your username and created for a namespace.
+!> 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_manifest, only: package_config_t, get_package_data
+  use fpm_model, only: fpm_model_t
+  use fpm_error, only: error_t, fpm_stop
+  use fpm_versioning, only: version_t
+  use fpm_filesystem, only: exists, join_path, get_tmp_directory
+  use fpm_git, only: git_archive, compressed_package_name
+  use fpm_downloader, only: downloader_t
+  use fpm_strings, only: string_t
+  use fpm_settings, only: official_registry_base_url
+  use fpm, only: build_model
+
+  implicit none
+  private
+  public :: cmd_publish
+
+contains
+
+  !> The `publish` command first builds the root package to obtain all the relevant information such as the
+  !> package version. It then creates a tarball of the package and uploads it to the registry.
+  subroutine cmd_publish(settings)
+    type(fpm_publish_settings), intent(inout) :: settings
+
+    type(package_config_t) :: package
+    type(fpm_model_t) :: model
+    type(error_t), allocatable :: error
+    type(version_t), allocatable :: version
+    type(string_t), allocatable :: form_data(:)
+    character(len=:), allocatable :: tmpdir
+    type(downloader_t) :: downloader
+    integer :: i
+
+    call get_package_data(package, 'fpm.toml', error, apply_defaults=.true.)
+    if (allocated(error)) call fpm_stop(1, '*cmd_build* Package error: '//error%message)
+    version = package%version
+
+    ! Build model to obtain dependency tree.
+    call build_model(model, settings%fpm_build_settings, package, error)
+    if (allocated(error)) call fpm_stop(1, '*cmd_build* Model error: '//error%message)
+
+    !> Checks before uploading the package.
+    if (.not. allocated(package%license)) call fpm_stop(1, 'No license specified in fpm.toml.')
+    if (.not. allocated(version)) call fpm_stop(1, 'No version specified in fpm.toml.')
+    if (version%s() == '0') call fpm_stop(1, 'Invalid version: "'//version%s()//'".')
+    if (.not. exists('fpm.toml')) call fpm_stop(1, "Cannot find 'fpm.toml' file. Are you in the project root?")
+
+    ! Check if package contains git dependencies. Only publish packages without git dependencies.
+    do i = 1, model%deps%ndep
+      if (allocated(model%deps%dep(i)%git)) then
+        call fpm_stop(1, "Do not publish packages containing git dependencies. '"//model%deps%dep(i)%name//"' is a git dependency.")
+      end if
+    end do
+
+    form_data = [ &
+      string_t('package_name="'//package%name//'"'), &
+      string_t('package_license="'//package%license//'"'), &
+      string_t('package_version="'//version%s()//'"') &
+      & ]
+
+    if (allocated(settings%token)) form_data = [form_data, string_t('upload_token="'//settings%token//'"')]
+
+    call get_tmp_directory(tmpdir, error)
+    if (allocated(error)) call fpm_stop(1, '*cmd_publish* Tmp directory error: '//error%message)
+    call git_archive('.', tmpdir, error)
+    if (allocated(error)) call fpm_stop(1, '*cmd_publish* Pack error: '//error%message)
+    form_data = [form_data, string_t('tarball=@"'//join_path(tmpdir, compressed_package_name)//'"')]
+
+    if (settings%show_form_data) then
+      do i = 1, size(form_data)
+        print *, form_data(i)%s
+      end do
+      return
+    end if
+
+    ! Make sure a token is provided for publishing.
+    if (.not. allocated(settings%token)) call fpm_stop(1, 'No token provided.')
+
+    call downloader%upload_form(official_registry_base_url//'/packages', form_data, error)
+    if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message)
+  end
+end

src/fpm/dependency.f90

@@ -668,8 +668,8 @@ subroutine get_from_registry(self, target_dir, global_settings, error, downloade
 
     ! Define location of the temporary folder and file.
     tmp_pkg_path = join_path(global_settings%path_to_config_folder, 'tmp')
-    tmp_pkg_file = join_path(tmp_pkg_path, 'package_data.tmp')
     if (.not. exists(tmp_pkg_path)) call mkdir(tmp_pkg_path)
+    tmp_pkg_file = join_path(tmp_pkg_path, 'package_data.tmp')
     open (newunit=unit, file=tmp_pkg_file, action='readwrite', iostat=stat)
     if (stat /= 0) then
       call fatal_error(error, "Error creating temporary file for downloading package '"//self%name//"'."); return
@@ -697,7 +697,6 @@ subroutine get_from_registry(self, target_dir, global_settings, error, downloade
       if (is_dir(cache_path)) call os_delete_dir(os_is_unix(), cache_path)
       call mkdir(cache_path)
 
-      print *, "Downloading '"//join_path(self%namespace, self%name, version%s())//"' ..."
       call downloader%get_file(target_url, tmp_pkg_file, error)
       if (allocated(error)) then
         close (unit, status='delete'); return
@@ -782,7 +781,7 @@ subroutine check_and_read_pkg_data(json, node, download_url, version, error)
       call fatal_error(error, "Failed to read download url for '"//join_path(node%namespace, node%name)//"'."); return
     end if
 
-    download_url = official_registry_base_url//'/'//download_url
+    download_url = official_registry_base_url//download_url
 
     if (.not. q%has_key('version')) then
       call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': No version found."); return

src/fpm/downloader.f90

@@ -3,6 +3,7 @@ module fpm_downloader
   use fpm_filesystem, only: which
   use fpm_versioning, only: version_t
   use jonquil, only: json_object, json_value, json_error, json_load, cast_to_object
+  use fpm_strings, only: string_t
 
   implicit none
   private
@@ -12,12 +13,12 @@ module fpm_downloader
   !> This type could be entirely avoided but it is quite practical because it can be mocked for testing.
   type downloader_t
   contains
-    procedure, nopass :: get_pkg_data, get_file, unpack
+    procedure, nopass :: get_pkg_data, get_file, upload_form, unpack
   end type
 
 contains
 
-  !> Perform an http get request and save output to file.
+  !> Perform an http get request, save output to file, and parse json.
   subroutine get_pkg_data(url, version, tmp_pkg_file, json, error)
     character(*), intent(in) :: url
     type(version_t), allocatable, intent(in) :: version
@@ -51,6 +52,7 @@ subroutine get_pkg_data(url, version, tmp_pkg_file, json, error)
     json = ptr
   end
 
+  !> Download a file from a url using either curl or wget.
   subroutine get_file(url, tmp_pkg_file, error)
     character(*), intent(in) :: url
     character(*), intent(in) :: tmp_pkg_file
@@ -59,10 +61,10 @@ subroutine get_file(url, tmp_pkg_file, error)
     integer :: stat
 
     if (which('curl') /= '') then
-      print *, "Downloading package data from '"//url//"' ..."
+      print *, "Downloading '"//url//"' -> '"//tmp_pkg_file//"'"
       call execute_command_line('curl '//url//' -s -o '//tmp_pkg_file, exitstat=stat)
     else if (which('wget') /= '') then
-      print *, "Downloading package data from '"//url//"' ..."
+      print *, "Downloading '"//url//"' -> '"//tmp_pkg_file//"'"
       call execute_command_line('wget '//url//' -q -O '//tmp_pkg_file, exitstat=stat)
     else
       call fatal_error(error, "Neither 'curl' nor 'wget' installed."); return
@@ -73,6 +75,33 @@ subroutine get_file(url, tmp_pkg_file, error)
     end if
   end
 
+  !> Perform an http post request with form data.
+  subroutine upload_form(endpoint, form_data, error)
+    character(len=*), intent(in) :: endpoint
+    type(string_t), intent(in) :: form_data(:)
+    type(error_t), allocatable, intent(out) :: error
+
+    integer :: stat, i
+    character(len=:), allocatable :: form_data_str
+
+    form_data_str = ''
+    do i = 1, size(form_data)
+      form_data_str = form_data_str//"-F '"//form_data(i)%s//"' "
+    end do
+
+    if (which('curl') /= '') then
+      print *, 'Uploading package ...'
+      call execute_command_line('curl -X POST -H "Content-Type: multipart/form-data" ' &
+      & //form_data_str//endpoint, exitstat=stat)
+    else
+      call fatal_error(error, "'curl' not installed."); return
+    end if
+
+    if (stat /= 0) then
+      call fatal_error(error, "Error uploading package to registry."); return
+    end if
+  end
+
   !> Unpack a tarball to a destination.
   subroutine unpack(tmp_pkg_file, destination, error)
     character(*), intent(in) :: tmp_pkg_file

src/fpm/error.f90

@@ -171,7 +171,7 @@ subroutine fpm_stop(value,message)
            flush(unit=stderr,iostat=iostat)
            flush(unit=stdout,iostat=iostat)
            if(value>0)then
-              write(stderr,'("<ERROR>",a)')trim(message)
+              write(stderr,'("<ERROR> ",a)')trim(message)
            else
               write(stderr,'("<INFO> ",a)')trim(message)
            endif

src/fpm/git.f90

@@ -1,16 +1,14 @@
 !> Implementation for interacting with git repositories.
 module fpm_git
     use fpm_error, only: error_t, fatal_error
-    use fpm_filesystem, only : get_temp_filename, getline, join_path
+    use fpm_filesystem, only : get_temp_filename, getline, join_path, execute_and_read_output
     implicit none
 
-    public :: git_target_t
-    public :: git_target_default, git_target_branch, git_target_tag, &
-        & git_target_revision
-    public :: git_revision
-    public :: git_matches_manifest
-    public :: operator(==)
-
+    public :: git_target_t, git_target_default, git_target_branch, git_target_tag, git_target_revision, git_revision, &
+            & git_archive, git_matches_manifest, operator(==), compressed_package_name
+
+    !> Name of the compressed package that is generated temporarily.
+    character(len=*), parameter :: compressed_package_name = 'compressed_package'
 
     !> Possible git target
     type :: enum_descriptor
@@ -307,5 +305,33 @@ subroutine info(self, unit, verbosity)
 
     end subroutine info
 
+  !> Archive a folder using `git archive`.
+  subroutine git_archive(source, destination, error)
+    !> Directory to archive.
+    character(*), intent(in) :: source
+    !> Destination of the archive.
+    character(*), intent(in) :: destination
+    !> Error handling.
+    type(error_t), allocatable, intent(out) :: error
+
+    integer :: stat
+    character(len=:), allocatable :: cmd_output, archive_format
+
+    call execute_and_read_output('git archive -l', cmd_output, error)
+    if (allocated(error)) return
+
+    if (index(cmd_output, 'tar.gz') /= 0) then
+      archive_format = 'tar.gz'
+    else
+      call fatal_error(error, "Cannot find a suitable archive format for 'git archive'."); return
+    end if
+
+    call execute_command_line('git archive HEAD --format='//archive_format//' -o '// &
+    & join_path(destination, compressed_package_name), exitstat=stat)
+    if (stat /= 0) then
+      call fatal_error(error, "Error packing '"//source//"'."); return
+    end if
+  end
+
 
 end module fpm_git

src/fpm/manifest/package.f90

@@ -80,6 +80,9 @@ module fpm_manifest_package
         !> Fortran meta data
         type(fortran_config_t) :: fortran
 
+        !> License meta data
+        character(len=:), allocatable :: license
+
         !> Library meta data
         type(library_config_t), allocatable :: library
 
@@ -151,6 +154,8 @@ subroutine new_package(self, table, root, error)
            return
         endif
 
+        call get_value(table, "license", self%license)
+
         if (len(self%name) <= 0) then
             call syntax_error(error, "Package name must be a non-empty string")
             return

src/fpm/manifest/test.f90

@@ -15,7 +15,7 @@
 !>[test.dependencies]
 !>```
 module fpm_manifest_test
-    use fpm_manifest_dependency, only : dependency_config_t, new_dependencies
+    use fpm_manifest_dependency, only : new_dependencies
     use fpm_manifest_executable, only : executable_config_t
     use fpm_error, only : error_t, syntax_error, bad_name_error
     use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list