Minor updates and fixes.

Author: interkosmos

Makefile

@@ -22,34 +22,34 @@ IMAP     = imap
 SMTP     = smtp
 VERSION  = version
 
-.PHONY: all clean dict download gopher http imap smtp version
+.PHONY: all clean
 
-all: $(TARGET)
+all: $(TARGET) $(DICT) $(DOWNLOAD) $(GOPHER) $(HTTP) $(IMAP) $(SMTP) $(VERSION)
 
 $(TARGET):
 	$(CC) $(CFLAGS) -c src/curlv.c
 	$(FC) $(FFLAGS) -c src/curl.f90
 	$(AR) $(ARFLAGS) $(TARGET) curl.o curlv.o
 
-dict: $(TARGET)
+$(DICT): $(TARGET)
 	$(FC) $(FFLAGS) $(LDFLAGS) -o $(DICT) examples/dict/dict.f90 $(TARGET) $(LDLIBS)
 
-download: $(TARGET)
+$(DOWNLOAD): $(TARGET)
 	$(FC) $(FFLAGS) $(LDFLAGS) -o $(DOWNLOAD) examples/download/download.f90 $(TARGET) $(LDLIBS)
 
-gopher: $(TARGET)
+$(GOPHER): $(TARGET)
 	$(FC) $(FFLAGS) $(LDFLAGS) -o $(GOPHER) examples/gopher/gopher.f90 $(TARGET) $(LDLIBS)
 
-http: $(TARGET)
+$(HTTP): $(TARGET)
 	$(FC) $(FFLAGS) $(LDFLAGS) -o $(HTTP) examples/http/http.f90 $(TARGET) $(LDLIBS)
 
-imap: $(TARGET)
+$(IMAP): $(TARGET)
 	$(FC) $(FFLAGS) $(LDFLAGS) -o $(IMAP) examples/imap/imap.f90 $(TARGET) $(LDLIBS)
 
-smtp: $(TARGET)
+$(SMTP): $(TARGET)
 	$(FC) $(FFLAGS) $(LDFLAGS) -o $(SMTP) examples/smtp/smtp.f90 $(TARGET) $(LDLIBS)
 
-version: $(TARGET)
+$(VERSION): $(TARGET)
 	$(FC) $(FFLAGS) $(LDFLAGS) -o $(VERSION) examples/version/version.f90 $(TARGET) $(LDLIBS)
 
 clean:

README.md

@@ -71,7 +71,7 @@ This projects supports the Fortran Package Manager
 run:
 
 ```
-$ fpm build
+$ fpm build --profile release
 ```
 
 The example applications are available with the ``fpm run --example`` command.
@@ -80,7 +80,7 @@ You can use ``fortran-curl`` in your *fpm* projects with
 
 ```toml
 [dependencies]
-fortran-curl.git = "https://interkosmos/fortran-curl.git"
+fortran-curl = { git = "https://github.com/interkosmos/fortran-curl.git" }
 ```
 
 ## Licence

examples/download/download.f90

@@ -46,10 +46,10 @@ function response_callback(ptr, size, nmemb, data) bind(c)
               position = 'append', &
               status   = 'unknown')
         if (rc /= 0) return
-        write (fu) chunk
+        write (fu, iostat=rc) chunk
         close (fu)
+        if (rc /= 0) return
 
-        deallocate (chunk)
         response_callback = nmemb
     end function response_callback
 end module callback_download

examples/http/http.f90

@@ -13,12 +13,11 @@ module callback_http
     integer(kind=8), parameter, public :: MAX_SIZE = 4096
 
     type, public :: response_type
-        character(len=MAX_SIZE) :: content
-        integer(kind=8)         :: size
+        character(len=:), allocatable :: body
     end type response_type
 contains
     ! static size_t callback(char *ptr, size_t size, size_t nmemb, void *data)
-    function response_callback(ptr, size, nmemb, data) bind(c)
+    function response_callback(ptr, size, nmemb, client_data) bind(c)
         !! Callback function for `CURLOPT_WRITEFUNCTION` that appends the
         !! response chunk `ptr` to the given `data` of type `response_type`.
         !!
@@ -28,35 +27,28 @@ function response_callback(ptr, size, nmemb, data) bind(c)
         type(c_ptr),            intent(in), value :: ptr               !! C pointer to a chunk of the response.
         integer(kind=c_size_t), intent(in), value :: size              !! Always 1.
         integer(kind=c_size_t), intent(in), value :: nmemb             !! Size of the response chunk.
-        type(c_ptr),            intent(in), value :: data              !! C pointer to argument passed by caller.
+        type(c_ptr),            intent(in), value :: client_data       !! C pointer to argument passed by caller.
         integer(kind=c_size_t)                    :: response_callback !! Function return value.
         type(response_type), pointer              :: response          !! Stores response.
-        character(len=:), allocatable             :: tmp
-        integer(kind=8)                           :: i, j
+        character(len=:), allocatable             :: buf
 
         response_callback = int(0, kind=c_size_t)
 
+        ! Are the passed C pointers associated?
         if (.not. c_associated(ptr)) return
-        if (.not. c_associated(data)) return
+        if (.not. c_associated(client_data)) return
 
-        call c_f_str_ptr(ptr, tmp, nmemb)
-        call c_f_pointer(data, response)
+        ! Convert C pointer to Fortran pointer.
+        call c_f_pointer(client_data, response)
+        if (.not. allocated(response%body)) response%body = ''
 
-        if (response%size == 0) then
-            response%content = tmp
-        else
-            i = response%size + 1
-            j = i + nmemb
+        ! Convert C pointer to Fortran allocatable character.
+        call c_f_str_ptr(ptr, buf, nmemb)
+        if (.not. allocated(buf)) return
+        response%body = response%body // buf
+        deallocate (buf)
 
-            if (i > MAX_SIZE) return
-            if (j > MAX_SIZE) j = MAX_SIZE
-
-            response%content(i:j) = tmp
-        end if
-
-        response%size = response%size + nmemb
-
-        deallocate (tmp)
+        ! Return number of received bytes.
         response_callback = nmemb
     end function response_callback
 end module callback_http
@@ -90,12 +82,15 @@ program main
     rc = curl_easy_setopt(curl_ptr, CURLOPT_WRITEDATA,        c_loc(response))
 
     ! Send request.
-    if (curl_easy_perform(curl_ptr) /= CURLE_OK) then
+    rc = curl_easy_perform(curl_ptr)
+    call curl_easy_cleanup(curl_ptr)
+
+    if (rc /= CURLE_OK) then
         print '(a)', 'Error: curl_easy_perform() failed'
+        stop
     end if
 
-    call curl_easy_cleanup(curl_ptr)
-
     ! Output response.
-    print '(a)', trim(response%content)
+    if (allocated(response%body)) &
+        print '(a)', response%body
 end program main

fpm.toml

@@ -1,5 +1,5 @@
 name = "fortran-curl"
-version = "0.1.1"
+version = "0.1.2"
 license = "ISC"
 author = "Philipp Engel"
 maintainer = "@interkosmos"

src/curl.f90

@@ -5,29 +5,9 @@
 ! Author:  Philipp Engel
 ! Licence: ISC
 module curl
-    use, intrinsic :: iso_c_binding, only: c_associated, c_char, c_f_pointer, c_funptr, &
-                                           c_int, c_int64_t, c_loc, c_long, c_ptr, c_size_t
+    use, intrinsic :: iso_c_binding
     implicit none
 
-    public :: c_f_str_ptr
-
-    public :: curl_easy_init
-    public :: curl_easy_perform
-    public :: curl_easy_cleanup
-    public :: curl_easy_setopt
-    public :: curl_easy_setopt_c_ptr
-    public :: curl_easy_setopt_c_funptr
-    public :: curl_slist_append
-    public :: curl_slist_free_all
-    public :: curl_version_info
-    public :: curl_version_now
-
-    private :: curl_easy_setopt_char
-    private :: curl_easy_setopt_fptr
-    private :: curl_easy_setopt_int
-    private :: curl_easy_setopt_long
-    private :: curl_easy_setopt_ptr
-
     integer(kind=c_int), parameter :: CURLOPTTYPE_LONG          = 0
     integer(kind=c_int), parameter :: CURLOPTTYPE_OBJECTPOINT   = 10000
     integer(kind=c_int), parameter :: CURLOPTTYPE_STRINGPOINT   = 10000
@@ -394,19 +374,22 @@ module curl
         ! CURL *curl_easy_init(void)
         function curl_easy_init() bind(c, name='curl_easy_init')
             import :: c_ptr
+            implicit none
             type(c_ptr) :: curl_easy_init
         end function curl_easy_init
 
         ! CURLcode curl_easy_perform(CURL *curl)
         function curl_easy_perform(curl) bind(c, name='curl_easy_perform')
             import :: c_int, c_ptr
+            implicit none
             type(c_ptr), intent(in), value :: curl
             integer(kind=c_int)            :: curl_easy_perform
         end function curl_easy_perform
 
         ! CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...)
         function curl_easy_setopt_c_ptr(curl, option, parameter) bind(c, name='curl_easy_setopt')
             import :: c_int, c_ptr
+            implicit none
             type(c_ptr),            intent(in), value :: curl
             integer(kind=c_int),    intent(in), value :: option
             type(c_ptr),            intent(in), value :: parameter
@@ -416,6 +399,7 @@ end function curl_easy_setopt_c_ptr
         ! CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...)
         function curl_easy_setopt_c_funptr(curl, option, parameter) bind(c, name='curl_easy_setopt')
             import :: c_funptr, c_int, c_ptr
+            implicit none
             type(c_ptr),            intent(in), value :: curl
             integer(kind=c_int),    intent(in), value :: option
             type(c_funptr),         intent(in), value :: parameter
@@ -425,6 +409,7 @@ end function curl_easy_setopt_c_funptr
         ! struct curl_slist *curl_slist_append(struct curl_slist *list, const char *string)
         function curl_slist_append(list, string) bind(c, name='curl_slist_append')
             import :: c_char, c_ptr
+            implicit none
             type(c_ptr),            intent(in), value :: list
             character(kind=c_char), intent(in)        :: string
             type(c_ptr)                               :: curl_slist_append
@@ -433,19 +418,22 @@ end function curl_slist_append
         ! curl_version_info_data *curl_version_info(CURLversion age)
         function curl_version_info_(age) bind(c, name='curl_version_info')
             import :: c_int, c_ptr
+            implicit none
             integer(kind=c_int), intent(in), value :: age
             type(c_ptr)                            :: curl_version_info_
         end function curl_version_info_
 
         ! void curl_easy_cleanup(CURL *curl)
         subroutine curl_easy_cleanup(curl) bind(c, name='curl_easy_cleanup')
             import :: c_ptr
+            implicit none
             type(c_ptr), intent(in), value :: curl
         end subroutine curl_easy_cleanup
 
         ! void curl_slist_free_all(struct curl_slist *list)
         subroutine curl_slist_free_all(list) bind(c, name='curl_slist_free_all')
             import :: c_ptr
+            implicit none
             type(c_ptr), intent(in), value :: list
         end subroutine curl_slist_free_all
     end interface
@@ -456,6 +444,7 @@ function curl_version_now() bind(c, name='curl_version_now')
             !! Interface to wrapper function `curl_version_now()` for C constant
             !! `CURLVERSION_NOW`.
             import :: c_int
+            implicit none
             integer(kind=c_int) :: curl_version_now
         end function curl_version_now
     end interface
@@ -476,10 +465,31 @@ end function curl_version_now
         ! size_t strlen(const char *str)
         function c_strlen(str) bind(c, name='strlen')
             import :: c_ptr, c_size_t
+            implicit none
             type(c_ptr), intent(in), value :: str
             integer(kind=c_size_t)         :: c_strlen
         end function c_strlen
     end interface
+
+    public :: c_f_str_ptr
+    public :: curl_easy_init
+    public :: curl_easy_perform
+    public :: curl_easy_cleanup
+    public :: curl_easy_setopt
+    public :: curl_easy_setopt_c_ptr
+    public :: curl_easy_setopt_c_funptr
+    public :: curl_slist_append
+    public :: curl_slist_free_all
+    public :: curl_version_info
+    public :: curl_version_now
+
+    private :: c_strlen
+    private :: copy
+    private :: curl_easy_setopt_char
+    private :: curl_easy_setopt_fptr
+    private :: curl_easy_setopt_int
+    private :: curl_easy_setopt_long
+    private :: curl_easy_setopt_ptr
 contains
     pure function copy(a)
         character, intent(in)  :: a(:)
@@ -577,7 +587,7 @@ subroutine c_f_str_ptr(c_str, f_str, size)
             sz = c_strlen(c_str)
         end if
 
-        if (sz <= 0) return
+        if (sz < 0) return
         call c_f_pointer(c_str, ptrs, [ sz ])
         allocate (character(len=sz) :: f_str)
         f_str = copy(ptrs)