Skip to content

Commit 45dd924

Browse files
interkosmosinterkosmos
committed
Added interface for curl_easy_setopt() to accept c_funptr arguments. Added DICT example.
1 parent a9b9b6f commit 45dd924

File tree

5 files changed

+122
-22
lines changed

5 files changed

+122
-22
lines changed

‎Makefile

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,14 +14,15 @@ LDLIBS = -lcurl
1414
ARFLAGS = rcs
1515
TARGET = libfortran-curl.a
1616

17+
DICT = dict
1718
DOWNLOAD = download
1819
GOPHER = gopher
1920
HTTP = http
2021
IMAP = imap
2122
SMTP = smtp
2223
VERSION = version
2324

24-
.PHONY: all clean download gopher http imap smtp version
25+
.PHONY: all clean dict download gopher http imap smtp version
2526

2627
all: $(TARGET)
2728

@@ -30,6 +31,9 @@ $(TARGET):
3031
$(FC) $(FFLAGS) -c src/curl.f90
3132
$(AR) $(ARFLAGS) $(TARGET) curl.o curlv.o
3233

34+
dict: $(TARGET)
35+
$(FC) $(FFLAGS) $(LDFLAGS) -o $(DICT) examples/dict/dict.f90 $(TARGET) $(LDLIBS)
36+
3337
download: $(TARGET)
3438
$(FC) $(FFLAGS) $(LDFLAGS) -o $(DOWNLOAD) examples/download/download.f90 $(TARGET) $(LDLIBS)
3539

@@ -52,6 +56,7 @@ clean:
5256
if [ `ls -1 *.mod 2>/dev/null | wc -l` -gt 0 ]; then rm *.mod; fi
5357
if [ `ls -1 *.o 2>/dev/null | wc -l` -gt 0 ]; then rm *.o; fi
5458
if [ -e $(TARGET) ]; then rm $(TARGET); fi
59+
if [ -e $(DICT) ]; then rm $(DICT); fi
5560
if [ -e $(DOWNLOAD) ]; then rm $(DOWNLOAD); fi
5661
if [ -e $(GOPHER) ]; then rm $(GOPHER); fi
5762
if [ -e $(HTTP) ]; then rm $(HTTP); fi

‎README.md

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ Link your Fortran application with `libfortran-curl.a -lcurl`.
3636
## Examples
3737
Examples are provided in directory `examples/`:
3838

39+
* **dict** queries a [DICT](https://en.wikipedia.org/wiki/DICT) server on TCP port 2628.
3940
* **download** fetches a remote file.
4041
* **gopher** prints the contents of a remote Gopher map file.
4142
* **http** makes an HTTP GET request.
@@ -50,15 +51,15 @@ $ make <name>
5051
```
5152

5253
## Coverage
53-
| C Function Name | Fortran Interface Name | Bound |
54-
|-----------------------|-----------------------------------------|-------|
55-
| `curl_easy_init` | `curl_easy_init` | ✓ |
56-
| `curl_easy_perform` | `curl_easy_perform` | ✓ |
57-
| `curl_easy_cleanup` | `curl_easy_cleanup` | ✓ |
58-
| `curl_easy_setopt` | `curl_easy_setopt`, `curl_easy_setopt_` | ✓ |
59-
| `curl_slist_append` | `curl_slist_append` | ✓ |
60-
| `curl_slist_free_all` | `curl_slist_free_all` | ✓ |
61-
| `curl_version_info` | `curl_version_info` | ✓ |
54+
| C Function Name | Fortran Interface Name | Bound |
55+
|-----------------------|---------------------------------------------------------------------------|-------|
56+
| `curl_easy_init` | `curl_easy_init` | ✓ |
57+
| `curl_easy_perform` | `curl_easy_perform` | ✓ |
58+
| `curl_easy_cleanup` | `curl_easy_cleanup` | ✓ |
59+
| `curl_easy_setopt` | `curl_easy_setopt`, `curl_easy_setopt_c_ptr`, `curl_easy_setopt_c_funptr` | ✓ |
60+
| `curl_slist_append` | `curl_slist_append` | ✓ |
61+
| `curl_slist_free_all` | `curl_slist_free_all` | ✓ |
62+
| `curl_version_info` | `curl_version_info` | ✓ |
6263

6364
| C Constant Name | Fortran Interface Name | Bound |
6465
|---------------------|------------------------|-------|

‎examples/dict/dict.f90

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
! dict.f90
2+
!
3+
! Basic dict protocol example, that looks up the definitions of the given words in
4+
! the dictionaries at dict://dict.org/ on port 2628. The program is equal to
5+
! running
6+
!
7+
! $ curl dict://dict.org/d:FORTRAN
8+
!
9+
! on the command-line.
10+
!
11+
! Author: John S. Urban, Philipp Engel
12+
! Licence: ISC
13+
module callback_dict
14+
use :: curl, only: c_f_str_ptr
15+
implicit none
16+
private
17+
public :: response_callback
18+
contains
19+
! static size_t callback(char *ptr, size_t size, size_t nmemb, void *data)
20+
function response_callback(ptr, size, nmemb, data) bind(c)
21+
!! Callback function for `CURLOPT_WRITEFUNCTION` that prints the
22+
!! response to standard output.
23+
!!
24+
!! This callback function might be called several times by libcurl,
25+
!! passing in more chunks of the response.
26+
use, intrinsic :: iso_c_binding, only: c_associated, c_f_pointer, c_ptr, c_size_t
27+
type(c_ptr), intent(in), value :: ptr !! C pointer to a chunk of the response.
28+
integer(kind=c_size_t), intent(in), value :: size !! Always 1.
29+
integer(kind=c_size_t), intent(in), value :: nmemb !! Size of the response chunk.
30+
type(c_ptr), intent(in), value :: data !! C pointer to argument passed by caller.
31+
integer(kind=c_size_t) :: response_callback !! Function return value.
32+
character(len=:), allocatable :: response
33+
34+
response_callback = int(0, kind=c_size_t)
35+
36+
if (.not. c_associated(ptr)) return
37+
38+
allocate (character(len=nmemb) :: response)
39+
call c_f_str_ptr(ptr, response)
40+
write (*, '(a)', advance='no') response
41+
deallocate (response)
42+
43+
response_callback = nmemb
44+
end function response_callback
45+
end module callback_dict
46+
47+
program main
48+
use, intrinsic :: iso_c_binding
49+
use :: curl
50+
use :: callback_dict
51+
implicit none
52+
53+
character(len=*), parameter :: DEFAULT_PROTOCOL = 'dict'
54+
character(len=*), parameter :: DEFAULT_URL = 'dict://dict.org/'
55+
character(len=*), parameter :: DICT_QUERY = 'd:FORTRAN'
56+
type(c_ptr) :: curl_ptr
57+
integer :: rc
58+
59+
curl_ptr = curl_easy_init()
60+
61+
if (.not. c_associated(curl_ptr)) then
62+
stop 'Error: curl_easy_init() failed'
63+
end if
64+
65+
! Set curl options.
66+
rc = curl_easy_setopt(curl_ptr, CURLOPT_DEFAULT_PROTOCOL, DEFAULT_PROTOCOL // c_null_char)
67+
rc = curl_easy_setopt(curl_ptr, CURLOPT_URL, DEFAULT_URL // DICT_QUERY // c_null_char)
68+
rc = curl_easy_setopt(curl_ptr, CURLOPT_TIMEOUT, int(10, kind=8))
69+
rc = curl_easy_setopt(curl_ptr, CURLOPT_NOSIGNAL, int( 1, kind=8))
70+
rc = curl_easy_setopt(curl_ptr, CURLOPT_CONNECTTIMEOUT, int(10, kind=8))
71+
rc = curl_easy_setopt(curl_ptr, CURLOPT_WRITEFUNCTION, c_funloc(response_callback))
72+
73+
! Send request.
74+
if (curl_easy_perform(curl_ptr) /= CURLE_OK) then
75+
print '(a)', 'Error: curl_easy_perform() failed'
76+
end if
77+
78+
call curl_easy_cleanup(curl_ptr)
79+
end program main

‎fpm.toml

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,20 @@
11
name = "fortran-curl"
2-
version = "0.1.0"
2+
version = "0.1.1"
33
license = "ISC"
44
author = "Philipp Engel"
55
maintainer = "@interkosmos"
6-
copyright = "Copyright (c) 2020, Philipp Engel"
6+
copyright = "Copyright (c) 2021, Philipp Engel"
77
description = "Fortran 2008 ISO C binding interfaces to libcurl"
8-
keywords = ["curl", "libcurl", "http", "gopher", "smtp", "imap"]
8+
keywords = ["curl", "libcurl", "http", "gopher", "smtp", "imap", "dict"]
99

1010
[build]
1111
link = "curl"
1212

13+
[[example]]
14+
name = "dict"
15+
source-dir = "examples/dict"
16+
main = "dict.f90"
17+
1318
[[example]]
1419
name = "download"
1520
source-dir = "examples/download"

‎src/curl.f90

Lines changed: 19 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,8 @@ module curl
1515
public :: curl_easy_perform
1616
public :: curl_easy_cleanup
1717
public :: curl_easy_setopt
18-
public :: curl_easy_setopt_
18+
public :: curl_easy_setopt_c_ptr
19+
public :: curl_easy_setopt_c_funptr
1920
public :: curl_slist_append
2021
public :: curl_slist_free_all
2122
public :: curl_version_info
@@ -404,13 +405,22 @@ function curl_easy_perform(curl) bind(c, name='curl_easy_perform')
404405
end function curl_easy_perform
405406

406407
! CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...)
407-
function curl_easy_setopt_(curl, option, parameter) bind(c, name='curl_easy_setopt')
408+
function curl_easy_setopt_c_ptr(curl, option, parameter) bind(c, name='curl_easy_setopt')
408409
import :: c_int, c_ptr
409410
type(c_ptr), intent(in), value :: curl
410411
integer(kind=c_int), intent(in), value :: option
411412
type(c_ptr), intent(in), value :: parameter
412-
integer(kind=c_int) :: curl_easy_setopt_
413-
end function curl_easy_setopt_
413+
integer(kind=c_int) :: curl_easy_setopt_c_ptr
414+
end function curl_easy_setopt_c_ptr
415+
416+
! CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...)
417+
function curl_easy_setopt_c_funptr(curl, option, parameter) bind(c, name='curl_easy_setopt')
418+
import :: c_funptr, c_int, c_ptr
419+
type(c_ptr), intent(in), value :: curl
420+
integer(kind=c_int), intent(in), value :: option
421+
type(c_funptr), intent(in), value :: parameter
422+
integer(kind=c_int) :: curl_easy_setopt_c_funptr
423+
end function curl_easy_setopt_c_funptr
414424

415425
! struct curl_slist *curl_slist_append(struct curl_slist *list, const char *string)
416426
function curl_slist_append(list, string) bind(c, name='curl_slist_append')
@@ -470,7 +480,7 @@ function curl_easy_setopt_char(curl, option, parameter)
470480
character(len=*), target, intent(in) :: parameter
471481
integer :: curl_easy_setopt_char
472482

473-
curl_easy_setopt_char = curl_easy_setopt_(curl, option, c_loc(parameter))
483+
curl_easy_setopt_char = curl_easy_setopt_c_ptr(curl, option, c_loc(parameter))
474484
end function curl_easy_setopt_char
475485

476486
! CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...)
@@ -480,7 +490,7 @@ function curl_easy_setopt_fptr(curl, option, parameter)
480490
type(c_funptr), intent(in) :: parameter
481491
integer :: curl_easy_setopt_fptr
482492

483-
curl_easy_setopt_fptr = curl_easy_setopt_(curl, option, parameter)
493+
curl_easy_setopt_fptr = curl_easy_setopt_c_funptr(curl, option, parameter)
484494
end function curl_easy_setopt_fptr
485495

486496
! CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...)
@@ -490,7 +500,7 @@ function curl_easy_setopt_int(curl, option, parameter)
490500
integer(kind=4), target, intent(in) :: parameter
491501
integer :: curl_easy_setopt_int
492502

493-
curl_easy_setopt_int = curl_easy_setopt_(curl, option, c_loc(parameter))
503+
curl_easy_setopt_int = curl_easy_setopt_c_ptr(curl, option, c_loc(parameter))
494504
end function curl_easy_setopt_int
495505

496506
! CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...)
@@ -500,7 +510,7 @@ function curl_easy_setopt_long(curl, option, parameter)
500510
integer(kind=8), target, intent(in) :: parameter
501511
integer :: curl_easy_setopt_long
502512

503-
curl_easy_setopt_long = curl_easy_setopt_(curl, option, c_loc(parameter))
513+
curl_easy_setopt_long = curl_easy_setopt_c_ptr(curl, option, c_loc(parameter))
504514
end function curl_easy_setopt_long
505515

506516
! CURLcode curl_easy_setopt(CURL *curl, CURLoption option, ...)
@@ -510,7 +520,7 @@ function curl_easy_setopt_ptr(curl, option, parameter)
510520
type(c_ptr), intent(in) :: parameter
511521
integer :: curl_easy_setopt_ptr
512522

513-
curl_easy_setopt_ptr = curl_easy_setopt_(curl, option, parameter)
523+
curl_easy_setopt_ptr = curl_easy_setopt_c_ptr(curl, option, parameter)
514524
end function curl_easy_setopt_ptr
515525

516526
! curl_version_info_data *curl_version_info(CURLversion age)

0 commit comments

Comments
 (0)