aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorJuanma Barranquero2011-05-04 16:03:16 +0200
committerJuanma Barranquero2011-05-04 16:03:16 +0200
commit0898ca10c0109274d24f91453036c065f9f5c056 (patch)
tree32c087173edd460b860b5c3ec8298777a39b52ca /src
parent67a2aecd40f802838d97f2aeb81f0a3698c68f62 (diff)
downloademacs-0898ca10c0109274d24f91453036c065f9f5c056.tar.gz
emacs-0898ca10c0109274d24f91453036c065f9f5c056.zip
Implement dynamic loading of GnuTLS on Windows.
* lisp/term/w32-win.el (dynamic-library-alist): Add `gnutls'. * nt/INSTALL: Clarify GnuTLS support. * src/callproc.c, src/emacs.c: Include lisp.h before src/w32.h, not after. * src/gnutls.c (Qgnutls_dll): Define. (DEF_GNUTLS_FN, LOAD_GNUTLS_FN): New macros. (gnutls_*): Declare function pointers. (init_gnutls_functions): New function to initialize function pointers. (emacs_gnutls_handshake, Fgnutls_error_string, Fgnutls_deinit) (emacs_gnutls_global_init, Fgnutls_bye): Use function pointers. (emacs_gnutls_record_check_pending, emacs_gnutls_transport_set_errno): Wrappers for gnutls_record_check_pending and gnutls_transport_set_errno. (emacs_gnutls_write, emacs_gnutls_read) (emacs_gnutls_handle_error, Fgnutls_error_fatalp) (Fgnutls_available_p): New function. (Fgnutls_boot): Call Fgnutls_available_p. Use function pointers. (syms_of_gnutls) <Qgnutls_dll>: Initialize and staticpro it. (syms_of_gnutls) <Sgnutls_available_p>: defsubr it. * src/gnutls.h (GNUTLS_EMACS_ERROR_NOT_LOADED): New macro. (emacs_gnutls_write, emacs_gnutls_read): Mark as extern. (emacs_gnutls_record_check_pending, emacs_gnutls_transport_set_errno): Declare. * src/w32.c (QCloaded_from, Vlibrary_cache): Define. (w32_delayed_load): Move from image.c. When loading a library, record its filename in the :loaded-from property of the library id. (globals_of_w32) <QCloaded_from, Vlibrary_cache>: Initialize and staticpro them. (emacs_gnutls_pull, emacs_gnutls_push): Call emacs_gnutls_* functions. * src/image.c: Include w32.h. (Vimage_type_cache): Delete. (syms_of_image) <Vimage_type_cache>: Don't initialize and staticpro it. (CACHE_IMAGE_TYPE, Finit_image_library): Use Vlibrary_cache instead. (w32_delayed_load): Move to w32.c. * src/process.c: Include lisp.h before src/w32.h, not after. (wait_reading_process_output): Call emacs_gnutls_record_check_pending instead of gnutls_record_check_pending. * src/w32.h (VlibraryCache, QCloaded_from, w32_delayed_load): Declare.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog45
-rw-r--r--src/callproc.c3
-rw-r--r--src/emacs.c3
-rw-r--r--src/gnutls.c322
-rw-r--r--src/gnutls.h8
-rw-r--r--src/image.c41
-rw-r--r--src/process.c7
-rw-r--r--src/w32.c62
-rw-r--r--src/w32.h3
9 files changed, 394 insertions, 100 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index bc6b89f1450..9e1705339de 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,48 @@
12011-05-04 Juanma Barranquero <lekktu@gmail.com>
2
3 Implement dynamic loading of GnuTLS on Windows.
4
5 * gnutls.h (GNUTLS_EMACS_ERROR_NOT_LOADED): New macro.
6 (emacs_gnutls_write, emacs_gnutls_read): Mark as extern.
7 (emacs_gnutls_record_check_pending, emacs_gnutls_transport_set_errno):
8 Declare.
9
10 * gnutls.c (Qgnutls_dll): Define.
11 (DEF_GNUTLS_FN, LOAD_GNUTLS_FN): New macros.
12 (gnutls_*): Declare function pointers.
13 (init_gnutls_functions): New function to initialize function pointers.
14 (emacs_gnutls_handshake, Fgnutls_error_string, Fgnutls_deinit)
15 (emacs_gnutls_global_init, Fgnutls_bye): Use function pointers.
16 (emacs_gnutls_record_check_pending, emacs_gnutls_transport_set_errno):
17 Wrappers for gnutls_record_check_pending and gnutls_transport_set_errno.
18 (emacs_gnutls_write, emacs_gnutls_read)
19 (emacs_gnutls_handle_error, Fgnutls_error_fatalp)
20 (Fgnutls_available_p): New function.
21 (Fgnutls_boot): Call Fgnutls_available_p. Use function pointers.
22 (syms_of_gnutls) <Qgnutls_dll>: Initialize and staticpro it.
23 (syms_of_gnutls) <Sgnutls_available_p>: defsubr it.
24
25 * image.c: Include w32.h.
26 (Vimage_type_cache): Delete.
27 (syms_of_image) <Vimage_type_cache>: Don't initialize and staticpro it.
28 (CACHE_IMAGE_TYPE, Finit_image_library): Use Vlibrary_cache instead.
29 (w32_delayed_load): Move to w32.c.
30
31 * w32.h (VlibraryCache, QCloaded_from, w32_delayed_load): Declare.
32
33 * w32.c (QCloaded_from, Vlibrary_cache): Define.
34 (w32_delayed_load): Move from image.c. When loading a library, record
35 its filename in the :loaded-from property of the library id.
36 (globals_of_w32) <QCloaded_from, Vlibrary_cache>:
37 Initialize and staticpro them.
38 (emacs_gnutls_pull, emacs_gnutls_push): Call emacs_gnutls_* functions.
39
40 * process.c: Include lisp.h before w32.h, not after.
41 (wait_reading_process_output): Call emacs_gnutls_record_check_pending
42 instead of gnutls_record_check_pending.
43
44 * callproc.c, emacs.c: Include lisp.h before w32.h, not after.
45
12011-05-04 Teodor Zlatanov <tzz@lifelogs.com> 462011-05-04 Teodor Zlatanov <tzz@lifelogs.com>
2 47
3 * gnutls.c (Fgnutls_boot): Support :keylist and :crlfiles options 48 * gnutls.c (Fgnutls_boot): Support :keylist and :crlfiles options
diff --git a/src/callproc.c b/src/callproc.c
index 4a29e95b356..1d3d8764ff8 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -29,6 +29,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
29#include <sys/file.h> 29#include <sys/file.h>
30#include <fcntl.h> 30#include <fcntl.h>
31 31
32#include "lisp.h"
33
32#ifdef WINDOWSNT 34#ifdef WINDOWSNT
33#define NOMINMAX 35#define NOMINMAX
34#include <windows.h> 36#include <windows.h>
@@ -41,7 +43,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
41#include <sys/param.h> 43#include <sys/param.h>
42#endif /* MSDOS */ 44#endif /* MSDOS */
43 45
44#include "lisp.h"
45#include "commands.h" 46#include "commands.h"
46#include "buffer.h" 47#include "buffer.h"
47#include "character.h" 48#include "character.h"
diff --git a/src/emacs.c b/src/emacs.c
index 0a132e156a0..8c4490b0a52 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -29,6 +29,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
29#include <setjmp.h> 29#include <setjmp.h>
30#include <unistd.h> 30#include <unistd.h>
31 31
32#include "lisp.h"
33
32#ifdef WINDOWSNT 34#ifdef WINDOWSNT
33#include <fcntl.h> 35#include <fcntl.h>
34#include <windows.h> /* just for w32.h */ 36#include <windows.h> /* just for w32.h */
@@ -41,7 +43,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
41#include <GNUstepBase/GSConfig.h> 43#include <GNUstepBase/GSConfig.h>
42#endif 44#endif
43 45
44#include "lisp.h"
45#include "commands.h" 46#include "commands.h"
46#include "intervals.h" 47#include "intervals.h"
47#include "buffer.h" 48#include "buffer.h"
diff --git a/src/gnutls.c b/src/gnutls.c
index fd970910d24..7e821ccd41d 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -34,6 +34,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
34static int 34static int
35emacs_gnutls_handle_error (gnutls_session_t, int err); 35emacs_gnutls_handle_error (gnutls_session_t, int err);
36 36
37static Lisp_Object Qgnutls_dll;
37static Lisp_Object Qgnutls_log_level; 38static Lisp_Object Qgnutls_log_level;
38static Lisp_Object Qgnutls_code; 39static Lisp_Object Qgnutls_code;
39static Lisp_Object Qgnutls_anon, Qgnutls_x509pki; 40static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
@@ -56,6 +57,181 @@ static Lisp_Object Qgnutls_bootprop_verify_hostname_error;
56/* Callback keys for `gnutls-boot'. Unused currently. */ 57/* Callback keys for `gnutls-boot'. Unused currently. */
57static Lisp_Object Qgnutls_bootprop_callbacks_verify; 58static Lisp_Object Qgnutls_bootprop_callbacks_verify;
58 59
60static void gnutls_log_function (int, const char *);
61static void gnutls_log_function2 (int, const char*, const char*);
62
63
64#ifdef WINDOWSNT
65
66/* Macro for defining functions that will be loaded from the GnuTLS DLL. */
67#define DEF_GNUTLS_FN(rettype,func,args) rettype (FAR CDECL *fn_##func)args
68
69/* Macro for loading GnuTLS functions from the library. */
70#define LOAD_GNUTLS_FN(lib,func) { \
71 fn_##func = (void *) GetProcAddress (lib, #func); \
72 if (!fn_##func) return 0; \
73 }
74
75DEF_GNUTLS_FN (gnutls_alert_description_t, gnutls_alert_get,
76 (gnutls_session_t));
77DEF_GNUTLS_FN (const char *, gnutls_alert_get_name,
78 (gnutls_alert_description_t));
79DEF_GNUTLS_FN (int, gnutls_alert_send_appropriate, (gnutls_session_t, int));
80DEF_GNUTLS_FN (int, gnutls_anon_allocate_client_credentials,
81 (gnutls_anon_client_credentials_t *));
82DEF_GNUTLS_FN (void, gnutls_anon_free_client_credentials,
83 (gnutls_anon_client_credentials_t));
84DEF_GNUTLS_FN (int, gnutls_bye, (gnutls_session_t, gnutls_close_request_t));
85DEF_GNUTLS_FN (int, gnutls_certificate_allocate_credentials,
86 (gnutls_certificate_credentials_t *));
87DEF_GNUTLS_FN (void, gnutls_certificate_free_credentials,
88 (gnutls_certificate_credentials_t));
89DEF_GNUTLS_FN (const gnutls_datum_t *, gnutls_certificate_get_peers,
90 (gnutls_session_t, unsigned int *));
91DEF_GNUTLS_FN (void, gnutls_certificate_set_verify_flags,
92 (gnutls_certificate_credentials_t, unsigned int));
93DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_crl_file,
94 (gnutls_certificate_credentials_t, const char *,
95 gnutls_x509_crt_fmt_t));
96DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_key_file,
97 (gnutls_certificate_credentials_t, const char *, const char *,
98 gnutls_x509_crt_fmt_t));
99DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_trust_file,
100 (gnutls_certificate_credentials_t, const char *,
101 gnutls_x509_crt_fmt_t));
102DEF_GNUTLS_FN (gnutls_certificate_type_t, gnutls_certificate_type_get,
103 (gnutls_session_t));
104DEF_GNUTLS_FN (int, gnutls_certificate_verify_peers2,
105 (gnutls_session_t, unsigned int *));
106DEF_GNUTLS_FN (int, gnutls_credentials_set,
107 (gnutls_session_t, gnutls_credentials_type_t, void *));
108DEF_GNUTLS_FN (void, gnutls_deinit, (gnutls_session_t));
109DEF_GNUTLS_FN (int, gnutls_error_is_fatal, (int));
110DEF_GNUTLS_FN (int, gnutls_global_init, (void));
111DEF_GNUTLS_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
112DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
113DEF_GNUTLS_FN (int, gnutls_handshake, (gnutls_session_t));
114DEF_GNUTLS_FN (int, gnutls_init, (gnutls_session_t *, gnutls_connection_end_t));
115DEF_GNUTLS_FN (int, gnutls_priority_set_direct,
116 (gnutls_session_t, const char *, const char **));
117DEF_GNUTLS_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
118DEF_GNUTLS_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
119DEF_GNUTLS_FN (ssize_t, gnutls_record_send,
120 (gnutls_session_t, const void *, size_t));
121DEF_GNUTLS_FN (const char *, gnutls_strerror, (int));
122DEF_GNUTLS_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
123DEF_GNUTLS_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
124DEF_GNUTLS_FN (void, gnutls_transport_set_ptr2,
125 (gnutls_session_t, gnutls_transport_ptr_t,
126 gnutls_transport_ptr_t));
127DEF_GNUTLS_FN (void, gnutls_transport_set_pull_function,
128 (gnutls_session_t, gnutls_pull_func));
129DEF_GNUTLS_FN (void, gnutls_transport_set_push_function,
130 (gnutls_session_t, gnutls_push_func));
131DEF_GNUTLS_FN (int, gnutls_x509_crt_check_hostname,
132 (gnutls_x509_crt_t, const char *));
133DEF_GNUTLS_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
134DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
135 (gnutls_x509_crt_t, const gnutls_datum_t *,
136 gnutls_x509_crt_fmt_t));
137DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
138
139static int
140init_gnutls_functions (Lisp_Object libraries)
141{
142 HMODULE library;
143
144 if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
145 {
146 GNUTLS_LOG (1, 1, "GnuTLS library not found");
147 return 0;
148 }
149
150 LOAD_GNUTLS_FN (library, gnutls_alert_get);
151 LOAD_GNUTLS_FN (library, gnutls_alert_get_name);
152 LOAD_GNUTLS_FN (library, gnutls_alert_send_appropriate);
153 LOAD_GNUTLS_FN (library, gnutls_anon_allocate_client_credentials);
154 LOAD_GNUTLS_FN (library, gnutls_anon_free_client_credentials);
155 LOAD_GNUTLS_FN (library, gnutls_bye);
156 LOAD_GNUTLS_FN (library, gnutls_certificate_allocate_credentials);
157 LOAD_GNUTLS_FN (library, gnutls_certificate_free_credentials);
158 LOAD_GNUTLS_FN (library, gnutls_certificate_get_peers);
159 LOAD_GNUTLS_FN (library, gnutls_certificate_set_verify_flags);
160 LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_crl_file);
161 LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_key_file);
162 LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_trust_file);
163 LOAD_GNUTLS_FN (library, gnutls_certificate_type_get);
164 LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
165 LOAD_GNUTLS_FN (library, gnutls_credentials_set);
166 LOAD_GNUTLS_FN (library, gnutls_deinit);
167 LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
168 LOAD_GNUTLS_FN (library, gnutls_global_init);
169 LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
170 LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
171 LOAD_GNUTLS_FN (library, gnutls_handshake);
172 LOAD_GNUTLS_FN (library, gnutls_init);
173 LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
174 LOAD_GNUTLS_FN (library, gnutls_record_check_pending);
175 LOAD_GNUTLS_FN (library, gnutls_record_recv);
176 LOAD_GNUTLS_FN (library, gnutls_record_send);
177 LOAD_GNUTLS_FN (library, gnutls_strerror);
178 LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
179 LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
180 LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
181 LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
182 LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
183 LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
184 LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
185 LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
186 LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
187
188 GNUTLS_LOG2 (1, 1, "GnuTLS library loaded:",
189 SDATA (Fget (Qgnutls_dll, QCloaded_from)));
190 return 1;
191}
192
193#else /* !WINDOWSNT */
194
195#define fn_gnutls_alert_get gnutls_alert_get
196#define fn_gnutls_alert_get_name gnutls_alert_get_name
197#define fn_gnutls_alert_send_appropriate gnutls_alert_send_appropriate
198#define fn_gnutls_anon_allocate_client_credentials gnutls_anon_allocate_client_credentials
199#define fn_gnutls_anon_free_client_credentials gnutls_anon_free_client_credentials
200#define fn_gnutls_bye gnutls_bye
201#define fn_gnutls_certificate_allocate_credentials gnutls_certificate_allocate_credentials
202#define fn_gnutls_certificate_free_credentials gnutls_certificate_free_credentials
203#define fn_gnutls_certificate_get_peers gnutls_certificate_get_peers
204#define fn_gnutls_certificate_set_verify_flags gnutls_certificate_set_verify_flags
205#define fn_gnutls_certificate_set_x509_crl_file gnutls_certificate_set_x509_crl_file
206#define fn_gnutls_certificate_set_x509_trust_file gnutls_certificate_set_x509_trust_file
207#define fn_gnutls_certificate_type_get gnutls_certificate_type_get
208#define fn_gnutls_certificate_verify_peers2 gnutls_certificate_verify_peers2
209#define fn_gnutls_credentials_set gnutls_credentials_set
210#define fn_gnutls_deinit gnutls_deinit
211#define fn_gnutls_error_is_fatal gnutls_error_is_fatal
212#define fn_gnutls_global_init gnutls_global_init
213#define fn_gnutls_global_set_log_function gnutls_global_set_log_function
214#define fn_gnutls_global_set_log_level gnutls_global_set_log_level
215#define fn_gnutls_handshake gnutls_handshake
216#define fn_gnutls_init gnutls_init
217#define fn_gnutls_priority_set_direct gnutls_priority_set_direct
218#define fn_gnutls_record_check_pending gnutls_record_check_pending
219#define fn_gnutls_record_recv gnutls_record_recv
220#define fn_gnutls_record_send gnutls_record_send
221#define fn_gnutls_strerror gnutls_strerror
222#define fn_gnutls_transport_set_errno gnutls_transport_set_errno
223#define fn_gnutls_transport_set_lowat gnutls_transport_set_lowat
224#define fn_gnutls_transport_set_ptr2 gnutls_transport_set_ptr2
225#define fn_gnutls_transport_set_pull_function gnutls_transport_set_pull_function
226#define fn_gnutls_transport_set_push_function gnutls_transport_set_push_function
227#define fn_gnutls_x509_crt_check_hostname gnutls_x509_crt_check_hostname
228#define fn_gnutls_x509_crt_deinit gnutls_x509_crt_deinit
229#define fn_gnutls_x509_crt_import gnutls_x509_crt_import
230#define fn_gnutls_x509_crt_init gnutls_x509_crt_init
231
232#endif /* !WINDOWSNT */
233
234
59static void 235static void
60gnutls_log_function (int level, const char* string) 236gnutls_log_function (int level, const char* string)
61{ 237{
@@ -83,11 +259,11 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
83 /* On W32 we cannot transfer socket handles between different runtime 259 /* On W32 we cannot transfer socket handles between different runtime
84 libraries, so we tell GnuTLS to use our special push/pull 260 libraries, so we tell GnuTLS to use our special push/pull
85 functions. */ 261 functions. */
86 gnutls_transport_set_ptr2 (state, 262 fn_gnutls_transport_set_ptr2 (state,
87 (gnutls_transport_ptr_t) proc, 263 (gnutls_transport_ptr_t) proc,
88 (gnutls_transport_ptr_t) proc); 264 (gnutls_transport_ptr_t) proc);
89 gnutls_transport_set_push_function (state, &emacs_gnutls_push); 265 fn_gnutls_transport_set_push_function (state, &emacs_gnutls_push);
90 gnutls_transport_set_pull_function (state, &emacs_gnutls_pull); 266 fn_gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
91 267
92 /* For non blocking sockets or other custom made pull/push 268 /* For non blocking sockets or other custom made pull/push
93 functions the gnutls_transport_set_lowat must be called, with 269 functions the gnutls_transport_set_lowat must be called, with
@@ -96,14 +272,14 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
96 (Note: this is probably not strictly necessary as the lowat 272 (Note: this is probably not strictly necessary as the lowat
97 value is only used when no custom pull/push functions are 273 value is only used when no custom pull/push functions are
98 set.) */ 274 set.) */
99 gnutls_transport_set_lowat (state, 0); 275 fn_gnutls_transport_set_lowat (state, 0);
100#else 276#else
101 /* This is how GnuTLS takes sockets: as file descriptors passed 277 /* This is how GnuTLS takes sockets: as file descriptors passed
102 in. For an Emacs process socket, infd and outfd are the 278 in. For an Emacs process socket, infd and outfd are the
103 same but we use this two-argument version for clarity. */ 279 same but we use this two-argument version for clarity. */
104 gnutls_transport_set_ptr2 (state, 280 fn_gnutls_transport_set_ptr2 (state,
105 (gnutls_transport_ptr_t) (long) proc->infd, 281 (gnutls_transport_ptr_t) (long) proc->infd,
106 (gnutls_transport_ptr_t) (long) proc->outfd); 282 (gnutls_transport_ptr_t) (long) proc->outfd);
107#endif 283#endif
108 284
109 proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET; 285 proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
@@ -111,10 +287,10 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
111 287
112 do 288 do
113 { 289 {
114 ret = gnutls_handshake (state); 290 ret = fn_gnutls_handshake (state);
115 emacs_gnutls_handle_error (state, ret); 291 emacs_gnutls_handle_error (state, ret);
116 } 292 }
117 while (ret < 0 && gnutls_error_is_fatal (ret) == 0); 293 while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
118 294
119 proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED; 295 proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
120 296
@@ -125,11 +301,23 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
125 } 301 }
126 else 302 else
127 { 303 {
128 gnutls_alert_send_appropriate (state, ret); 304 fn_gnutls_alert_send_appropriate (state, ret);
129 } 305 }
130 return ret; 306 return ret;
131} 307}
132 308
309int
310emacs_gnutls_record_check_pending (gnutls_session_t state)
311{
312 return fn_gnutls_record_check_pending (state);
313}
314
315void
316emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
317{
318 fn_gnutls_transport_set_errno (state, err);
319}
320
133EMACS_INT 321EMACS_INT
134emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf, 322emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
135 EMACS_INT nbyte) 323 EMACS_INT nbyte)
@@ -152,7 +340,7 @@ emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
152 340
153 while (nbyte > 0) 341 while (nbyte > 0)
154 { 342 {
155 rtnval = gnutls_write (state, buf, nbyte); 343 rtnval = fn_gnutls_record_send (state, buf, nbyte);
156 344
157 if (rtnval < 0) 345 if (rtnval < 0)
158 { 346 {
@@ -183,7 +371,7 @@ emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,
183 emacs_gnutls_handshake (proc); 371 emacs_gnutls_handshake (proc);
184 return -1; 372 return -1;
185 } 373 }
186 rtnval = gnutls_read (state, buf, nbyte); 374 rtnval = fn_gnutls_record_recv (state, buf, nbyte);
187 if (rtnval >= 0) 375 if (rtnval >= 0)
188 return rtnval; 376 return rtnval;
189 else if (emacs_gnutls_handle_error (state, rtnval) == 0) 377 else if (emacs_gnutls_handle_error (state, rtnval) == 0)
@@ -215,11 +403,11 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
215 403
216 /* TODO: use gnutls-error-fatalp and gnutls-error-string. */ 404 /* TODO: use gnutls-error-fatalp and gnutls-error-string. */
217 405
218 str = gnutls_strerror (err); 406 str = fn_gnutls_strerror (err);
219 if (!str) 407 if (!str)
220 str = "unknown"; 408 str = "unknown";
221 409
222 if (gnutls_error_is_fatal (err)) 410 if (fn_gnutls_error_is_fatal (err))
223 { 411 {
224 ret = err; 412 ret = err;
225 GNUTLS_LOG2 (0, max_log_level, "fatal error:", str); 413 GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
@@ -234,9 +422,9 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
234 if (err == GNUTLS_E_WARNING_ALERT_RECEIVED 422 if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
235 || err == GNUTLS_E_FATAL_ALERT_RECEIVED) 423 || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
236 { 424 {
237 int alert = gnutls_alert_get (session); 425 int alert = fn_gnutls_alert_get (session);
238 int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1; 426 int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
239 str = gnutls_alert_get_name (alert); 427 str = fn_gnutls_alert_get_name (alert);
240 if (!str) 428 if (!str)
241 str = "unknown"; 429 str = "unknown";
242 430
@@ -314,7 +502,7 @@ usage: (gnutls-error-fatalp ERROR) */)
314 if (!NUMBERP (err)) 502 if (!NUMBERP (err))
315 error ("Not an error symbol or code"); 503 error ("Not an error symbol or code");
316 504
317 if (0 == gnutls_error_is_fatal (XINT (err))) 505 if (0 == fn_gnutls_error_is_fatal (XINT (err)))
318 return Qnil; 506 return Qnil;
319 507
320 return Qt; 508 return Qt;
@@ -346,7 +534,7 @@ usage: (gnutls-error-string ERROR) */)
346 if (!NUMBERP (err)) 534 if (!NUMBERP (err))
347 return build_string ("Not an error symbol or code"); 535 return build_string ("Not an error symbol or code");
348 536
349 return build_string (gnutls_strerror (XINT (err))); 537 return build_string (fn_gnutls_strerror (XINT (err)));
350} 538}
351 539
352DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, 540DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
@@ -361,13 +549,34 @@ See also `gnutls-init'. */)
361 549
362 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT) 550 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
363 { 551 {
364 gnutls_deinit (state); 552 fn_gnutls_deinit (state);
365 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1; 553 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
366 } 554 }
367 555
368 return Qt; 556 return Qt;
369} 557}
370 558
559DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
560 doc: /* Return t if GnuTLS is available in this instance of Emacs. */)
561 (void)
562{
563#ifdef WINDOWSNT
564 Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
565 if (CONSP (found))
566 return XCDR (found);
567 else
568 {
569 Lisp_Object status;
570 status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
571 Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
572 return status;
573 }
574#else
575 return Qt;
576#endif
577}
578
579
371/* Initializes global GnuTLS state to defaults. 580/* Initializes global GnuTLS state to defaults.
372Call `gnutls-global-deinit' when GnuTLS usage is no longer needed. 581Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
373Returns zero on success. */ 582Returns zero on success. */
@@ -377,8 +586,7 @@ emacs_gnutls_global_init (void)
377 int ret = GNUTLS_E_SUCCESS; 586 int ret = GNUTLS_E_SUCCESS;
378 587
379 if (!gnutls_global_initialized) 588 if (!gnutls_global_initialized)
380 ret = gnutls_global_init (); 589 ret = fn_gnutls_global_init ();
381
382 gnutls_global_initialized = 1; 590 gnutls_global_initialized = 1;
383 591
384 return gnutls_make_error (ret); 592 return gnutls_make_error (ret);
@@ -488,6 +696,12 @@ one trustfile (usually a CA bundle). */)
488 CHECK_SYMBOL (type); 696 CHECK_SYMBOL (type);
489 CHECK_LIST (proplist); 697 CHECK_LIST (proplist);
490 698
699 if (NILP (Fgnutls_available_p ()))
700 {
701 error ("GnuTLS not available");
702 return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
703 }
704
491 hostname = Fplist_get (proplist, Qgnutls_bootprop_hostname); 705 hostname = Fplist_get (proplist, Qgnutls_bootprop_hostname);
492 priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority); 706 priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
493 trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles); 707 trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
@@ -509,8 +723,8 @@ one trustfile (usually a CA bundle). */)
509 723
510 if (NUMBERP (loglevel)) 724 if (NUMBERP (loglevel))
511 { 725 {
512 gnutls_global_set_log_function (gnutls_log_function); 726 fn_gnutls_global_set_log_function (gnutls_log_function);
513 gnutls_global_set_log_level (XINT (loglevel)); 727 fn_gnutls_global_set_log_level (XINT (loglevel));
514 max_log_level = XINT (loglevel); 728 max_log_level = XINT (loglevel);
515 XPROCESS (proc)->gnutls_log_level = max_log_level; 729 XPROCESS (proc)->gnutls_log_level = max_log_level;
516 } 730 }
@@ -529,13 +743,13 @@ one trustfile (usually a CA bundle). */)
529 { 743 {
530 GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials"); 744 GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
531 x509_cred = XPROCESS (proc)->gnutls_x509_cred; 745 x509_cred = XPROCESS (proc)->gnutls_x509_cred;
532 gnutls_certificate_free_credentials (x509_cred); 746 fn_gnutls_certificate_free_credentials (x509_cred);
533 } 747 }
534 else if (EQ (type, Qgnutls_anon)) 748 else if (EQ (type, Qgnutls_anon))
535 { 749 {
536 GNUTLS_LOG (2, max_log_level, "deallocating anon credentials"); 750 GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
537 anon_cred = XPROCESS (proc)->gnutls_anon_cred; 751 anon_cred = XPROCESS (proc)->gnutls_anon_cred;
538 gnutls_anon_free_client_credentials (anon_cred); 752 fn_gnutls_anon_free_client_credentials (anon_cred);
539 } 753 }
540 else 754 else
541 { 755 {
@@ -558,7 +772,7 @@ one trustfile (usually a CA bundle). */)
558 { 772 {
559 GNUTLS_LOG (2, max_log_level, "allocating x509 credentials"); 773 GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
560 x509_cred = XPROCESS (proc)->gnutls_x509_cred; 774 x509_cred = XPROCESS (proc)->gnutls_x509_cred;
561 if (gnutls_certificate_allocate_credentials (&x509_cred) < 0) 775 if (fn_gnutls_certificate_allocate_credentials (&x509_cred) < 0)
562 memory_full (); 776 memory_full ();
563 777
564 if (NUMBERP (verify_flags)) 778 if (NUMBERP (verify_flags))
@@ -576,13 +790,13 @@ one trustfile (usually a CA bundle). */)
576 /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */ 790 /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */
577 GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags"); 791 GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
578 } 792 }
579 gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags); 793 fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
580 } 794 }
581 else if (EQ (type, Qgnutls_anon)) 795 else if (EQ (type, Qgnutls_anon))
582 { 796 {
583 GNUTLS_LOG (2, max_log_level, "allocating anon credentials"); 797 GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
584 anon_cred = XPROCESS (proc)->gnutls_anon_cred; 798 anon_cred = XPROCESS (proc)->gnutls_anon_cred;
585 if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0) 799 if (fn_gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
586 memory_full (); 800 memory_full ();
587 } 801 }
588 else 802 else
@@ -605,7 +819,7 @@ one trustfile (usually a CA bundle). */)
605 { 819 {
606 GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ", 820 GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
607 SSDATA (trustfile)); 821 SSDATA (trustfile));
608 ret = gnutls_certificate_set_x509_trust_file 822 ret = fn_gnutls_certificate_set_x509_trust_file
609 (x509_cred, 823 (x509_cred,
610 SSDATA (trustfile), 824 SSDATA (trustfile),
611 file_format); 825 file_format);
@@ -627,7 +841,7 @@ one trustfile (usually a CA bundle). */)
627 { 841 {
628 GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ", 842 GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
629 SSDATA (crlfile)); 843 SSDATA (crlfile));
630 ret = gnutls_certificate_set_x509_crl_file 844 ret = fn_gnutls_certificate_set_x509_crl_file
631 (x509_cred, 845 (x509_cred,
632 SSDATA (crlfile), 846 SSDATA (crlfile),
633 file_format); 847 file_format);
@@ -652,7 +866,7 @@ one trustfile (usually a CA bundle). */)
652 SSDATA (keyfile)); 866 SSDATA (keyfile));
653 GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ", 867 GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
654 SSDATA (certfile)); 868 SSDATA (certfile));
655 ret = gnutls_certificate_set_x509_key_file 869 ret = fn_gnutls_certificate_set_x509_key_file
656 (x509_cred, 870 (x509_cred,
657 SSDATA (certfile), 871 SSDATA (certfile),
658 SSDATA (keyfile), 872 SSDATA (keyfile),
@@ -685,7 +899,7 @@ one trustfile (usually a CA bundle). */)
685 899
686 GNUTLS_LOG (1, max_log_level, "gnutls_init"); 900 GNUTLS_LOG (1, max_log_level, "gnutls_init");
687 901
688 ret = gnutls_init (&state, GNUTLS_CLIENT); 902 ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
689 903
690 if (ret < GNUTLS_E_SUCCESS) 904 if (ret < GNUTLS_E_SUCCESS)
691 return gnutls_make_error (ret); 905 return gnutls_make_error (ret);
@@ -708,9 +922,9 @@ one trustfile (usually a CA bundle). */)
708 922
709 GNUTLS_LOG (1, max_log_level, "setting the priority string"); 923 GNUTLS_LOG (1, max_log_level, "setting the priority string");
710 924
711 ret = gnutls_priority_set_direct (state, 925 ret = fn_gnutls_priority_set_direct (state,
712 priority_string_ptr, 926 priority_string_ptr,
713 NULL); 927 NULL);
714 928
715 if (ret < GNUTLS_E_SUCCESS) 929 if (ret < GNUTLS_E_SUCCESS)
716 return gnutls_make_error (ret); 930 return gnutls_make_error (ret);
@@ -719,11 +933,11 @@ one trustfile (usually a CA bundle). */)
719 933
720 if (EQ (type, Qgnutls_x509pki)) 934 if (EQ (type, Qgnutls_x509pki))
721 { 935 {
722 ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred); 936 ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
723 } 937 }
724 else if (EQ (type, Qgnutls_anon)) 938 else if (EQ (type, Qgnutls_anon))
725 { 939 {
726 ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred); 940 ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
727 } 941 }
728 else 942 else
729 { 943 {
@@ -751,7 +965,7 @@ one trustfile (usually a CA bundle). */)
751 check of the certificate's hostname with 965 check of the certificate's hostname with
752 gnutls_x509_crt_check_hostname() against :hostname. */ 966 gnutls_x509_crt_check_hostname() against :hostname. */
753 967
754 ret = gnutls_certificate_verify_peers2 (state, &peer_verification); 968 ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
755 969
756 if (ret < GNUTLS_E_SUCCESS) 970 if (ret < GNUTLS_E_SUCCESS)
757 return gnutls_make_error (ret); 971 return gnutls_make_error (ret);
@@ -802,15 +1016,15 @@ one trustfile (usually a CA bundle). */)
802 /* Up to here the process is the same for X.509 certificates and 1016 /* Up to here the process is the same for X.509 certificates and
803 OpenPGP keys. From now on X.509 certificates are assumed. This 1017 OpenPGP keys. From now on X.509 certificates are assumed. This
804 can be easily extended to work with openpgp keys as well. */ 1018 can be easily extended to work with openpgp keys as well. */
805 if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509) 1019 if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
806 { 1020 {
807 ret = gnutls_x509_crt_init (&gnutls_verify_cert); 1021 ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
808 1022
809 if (ret < GNUTLS_E_SUCCESS) 1023 if (ret < GNUTLS_E_SUCCESS)
810 return gnutls_make_error (ret); 1024 return gnutls_make_error (ret);
811 1025
812 gnutls_verify_cert_list = 1026 gnutls_verify_cert_list =
813 gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size); 1027 fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
814 1028
815 if (NULL == gnutls_verify_cert_list) 1029 if (NULL == gnutls_verify_cert_list)
816 { 1030 {
@@ -818,17 +1032,17 @@ one trustfile (usually a CA bundle). */)
818 } 1032 }
819 1033
820 /* We only check the first certificate in the given chain. */ 1034 /* We only check the first certificate in the given chain. */
821 ret = gnutls_x509_crt_import (gnutls_verify_cert, 1035 ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
822 &gnutls_verify_cert_list[0], 1036 &gnutls_verify_cert_list[0],
823 GNUTLS_X509_FMT_DER); 1037 GNUTLS_X509_FMT_DER);
824 1038
825 if (ret < GNUTLS_E_SUCCESS) 1039 if (ret < GNUTLS_E_SUCCESS)
826 { 1040 {
827 gnutls_x509_crt_deinit (gnutls_verify_cert); 1041 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
828 return gnutls_make_error (ret); 1042 return gnutls_make_error (ret);
829 } 1043 }
830 1044
831 if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname)) 1045 if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
832 { 1046 {
833 if (NILP (verify_hostname_error)) 1047 if (NILP (verify_hostname_error))
834 { 1048 {
@@ -837,13 +1051,13 @@ one trustfile (usually a CA bundle). */)
837 } 1051 }
838 else 1052 else
839 { 1053 {
840 gnutls_x509_crt_deinit (gnutls_verify_cert); 1054 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
841 error ("The x509 certificate does not match \"%s\"", 1055 error ("The x509 certificate does not match \"%s\"",
842 c_hostname); 1056 c_hostname);
843 } 1057 }
844 } 1058 }
845 1059
846 gnutls_x509_crt_deinit (gnutls_verify_cert); 1060 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
847 } 1061 }
848 1062
849 return gnutls_make_error (ret); 1063 return gnutls_make_error (ret);
@@ -872,8 +1086,8 @@ This function may also return `gnutls-e-again', or
872 1086
873 state = XPROCESS (proc)->gnutls_state; 1087 state = XPROCESS (proc)->gnutls_state;
874 1088
875 ret = gnutls_bye (state, 1089 ret = fn_gnutls_bye (state,
876 NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR); 1090 NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
877 1091
878 return gnutls_make_error (ret); 1092 return gnutls_make_error (ret);
879} 1093}
@@ -883,6 +1097,9 @@ syms_of_gnutls (void)
883{ 1097{
884 gnutls_global_initialized = 0; 1098 gnutls_global_initialized = 0;
885 1099
1100 Qgnutls_dll = intern_c_string ("gnutls");
1101 staticpro (&Qgnutls_dll);
1102
886 Qgnutls_log_level = intern_c_string ("gnutls-log-level"); 1103 Qgnutls_log_level = intern_c_string ("gnutls-log-level");
887 staticpro (&Qgnutls_log_level); 1104 staticpro (&Qgnutls_log_level);
888 1105
@@ -956,6 +1173,7 @@ syms_of_gnutls (void)
956 defsubr (&Sgnutls_boot); 1173 defsubr (&Sgnutls_boot);
957 defsubr (&Sgnutls_deinit); 1174 defsubr (&Sgnutls_deinit);
958 defsubr (&Sgnutls_bye); 1175 defsubr (&Sgnutls_bye);
1176 defsubr (&Sgnutls_available_p);
959} 1177}
960 1178
961#endif /* HAVE_GNUTLS */ 1179#endif /* HAVE_GNUTLS */
diff --git a/src/gnutls.h b/src/gnutls.h
index 6c2e4c69523..afe6337fac2 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -42,6 +42,7 @@ typedef enum
42 GNUTLS_STAGE_READY, 42 GNUTLS_STAGE_READY,
43} gnutls_initstage_t; 43} gnutls_initstage_t;
44 44
45#define GNUTLS_EMACS_ERROR_NOT_LOADED GNUTLS_E_APPLICATION_ERROR_MIN + 1
45#define GNUTLS_EMACS_ERROR_INVALID_TYPE GNUTLS_E_APPLICATION_ERROR_MIN 46#define GNUTLS_EMACS_ERROR_INVALID_TYPE GNUTLS_E_APPLICATION_ERROR_MIN
46 47
47#define GNUTLS_INITSTAGE(proc) (XPROCESS (proc)->gnutls_initstage) 48#define GNUTLS_INITSTAGE(proc) (XPROCESS (proc)->gnutls_initstage)
@@ -52,13 +53,16 @@ typedef enum
52 53
53#define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } 54#define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); }
54 55
55EMACS_INT 56extern EMACS_INT
56emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf, 57emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
57 EMACS_INT nbyte); 58 EMACS_INT nbyte);
58EMACS_INT 59extern EMACS_INT
59emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf, 60emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,
60 EMACS_INT nbyte); 61 EMACS_INT nbyte);
61 62
63extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
64extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
65
62extern void syms_of_gnutls (void); 66extern void syms_of_gnutls (void);
63 67
64#endif 68#endif
diff --git a/src/image.c b/src/image.c
index 6feeb75afd6..2377b41735d 100644
--- a/src/image.c
+++ b/src/image.c
@@ -67,6 +67,7 @@ typedef struct x_bitmap_record Bitmap_Record;
67 67
68 68
69#ifdef HAVE_NTGUI 69#ifdef HAVE_NTGUI
70#include "w32.h"
70#include "w32term.h" 71#include "w32term.h"
71 72
72/* W32_TODO : Color tables on W32. */ 73/* W32_TODO : Color tables on W32. */
@@ -556,10 +557,6 @@ x_create_bitmap_mask (struct frame *f, int id)
556 557
557static struct image_type *image_types; 558static struct image_type *image_types;
558 559
559/* Cache for delayed-loading image types. */
560
561static Lisp_Object Vimage_type_cache;
562
563/* The symbol `xbm' which is used as the type symbol for XBM images. */ 560/* The symbol `xbm' which is used as the type symbol for XBM images. */
564 561
565static Lisp_Object Qxbm; 562static Lisp_Object Qxbm;
@@ -589,7 +586,7 @@ static int x_build_heuristic_mask (struct frame *, struct image *,
589 Lisp_Object); 586 Lisp_Object);
590 587
591#define CACHE_IMAGE_TYPE(type, status) \ 588#define CACHE_IMAGE_TYPE(type, status) \
592 do { Vimage_type_cache = Fcons (Fcons (type, status), Vimage_type_cache); } while (0) 589 do { Vlibrary_cache = Fcons (Fcons (type, status), Vlibrary_cache); } while (0)
593 590
594#define ADD_IMAGE_TYPE(type) \ 591#define ADD_IMAGE_TYPE(type) \
595 do { Vimage_types = Fcons (type, Vimage_types); } while (0) 592 do { Vimage_types = Fcons (type, Vimage_types); } while (0)
@@ -1900,34 +1897,6 @@ mark_image_cache (struct image_cache *c)
1900 if (!fn_##func) return 0; \ 1897 if (!fn_##func) return 0; \
1901 } 1898 }
1902 1899
1903/* Load a DLL implementing an image type.
1904 The argument LIBRARIES is usually the variable
1905 `dynamic-library-alist', which associates a symbol, identifying
1906 an external DLL library, to a list of possible filenames.
1907 The function returns NULL if no library could be loaded for
1908 the given symbol, or if the library was previously loaded;
1909 else the handle of the DLL. */
1910static HMODULE
1911w32_delayed_load (Lisp_Object libraries, Lisp_Object type)
1912{
1913 HMODULE library = NULL;
1914
1915 if (CONSP (libraries) && NILP (Fassq (type, Vimage_type_cache)))
1916 {
1917 Lisp_Object dlls = Fassq (type, libraries);
1918
1919 if (CONSP (dlls))
1920 for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
1921 {
1922 CHECK_STRING_CAR (dlls);
1923 if (library = LoadLibrary (SDATA (XCAR (dlls))))
1924 break;
1925 }
1926 }
1927
1928 return library;
1929}
1930
1931#endif /* HAVE_NTGUI */ 1900#endif /* HAVE_NTGUI */
1932 1901
1933static int x_create_x_image_and_pixmap (struct frame *, int, int, int, 1902static int x_create_x_image_and_pixmap (struct frame *, int, int, int,
@@ -5452,7 +5421,6 @@ init_png_functions (Lisp_Object libraries)
5452{ 5421{
5453 HMODULE library; 5422 HMODULE library;
5454 5423
5455 /* Try loading libpng under probable names. */
5456 if (!(library = w32_delayed_load (libraries, Qpng))) 5424 if (!(library = w32_delayed_load (libraries, Qpng)))
5457 return 0; 5425 return 0;
5458 5426
@@ -8634,7 +8602,7 @@ of `dynamic-library-alist', which see). */)
8634 Lisp_Object tested; 8602 Lisp_Object tested;
8635 8603
8636 /* Don't try to reload the library. */ 8604 /* Don't try to reload the library. */
8637 tested = Fassq (type, Vimage_type_cache); 8605 tested = Fassq (type, Vlibrary_cache);
8638 if (CONSP (tested)) 8606 if (CONSP (tested))
8639 return XCDR (tested); 8607 return XCDR (tested);
8640 8608
@@ -8714,9 +8682,6 @@ as a ratio to the frame height and width. If the value is
8714non-numeric, there is no explicit limit on the size of images. */); 8682non-numeric, there is no explicit limit on the size of images. */);
8715 Vmax_image_size = make_float (MAX_IMAGE_SIZE); 8683 Vmax_image_size = make_float (MAX_IMAGE_SIZE);
8716 8684
8717 Vimage_type_cache = Qnil;
8718 staticpro (&Vimage_type_cache);
8719
8720 Qpbm = intern_c_string ("pbm"); 8685 Qpbm = intern_c_string ("pbm");
8721 staticpro (&Qpbm); 8686 staticpro (&Qpbm);
8722 ADD_IMAGE_TYPE (Qpbm); 8687 ADD_IMAGE_TYPE (Qpbm);
diff --git a/src/process.c b/src/process.c
index 53703078307..454f7d8a9aa 100644
--- a/src/process.c
+++ b/src/process.c
@@ -33,6 +33,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
33#include <unistd.h> 33#include <unistd.h>
34#include <fcntl.h> 34#include <fcntl.h>
35 35
36#include "lisp.h"
37
36/* Only MS-DOS does not define `subprocesses'. */ 38/* Only MS-DOS does not define `subprocesses'. */
37#ifdef subprocesses 39#ifdef subprocesses
38 40
@@ -77,7 +79,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
77 79
78#endif /* subprocesses */ 80#endif /* subprocesses */
79 81
80#include "lisp.h"
81#include "systime.h" 82#include "systime.h"
82#include "systty.h" 83#include "systty.h"
83 84
@@ -4537,10 +4538,10 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
4537 some data in the TCP buffers so that select works, but 4538 some data in the TCP buffers so that select works, but
4538 with custom pull/push functions we need to check if some 4539 with custom pull/push functions we need to check if some
4539 data is available in the buffers manually. */ 4540 data is available in the buffers manually. */
4540 if (nfds == 0 && 4541 if (nfds == 0 &&
4541 wait_proc && wait_proc->gnutls_p /* Check for valid process. */ 4542 wait_proc && wait_proc->gnutls_p /* Check for valid process. */
4542 /* Do we have pending data? */ 4543 /* Do we have pending data? */
4543 && gnutls_record_check_pending (wait_proc->gnutls_state) > 0) 4544 && emacs_gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
4544 { 4545 {
4545 nfds = 1; 4546 nfds = 1;
4546 /* Set to Available. */ 4547 /* Set to Available. */
diff --git a/src/w32.c b/src/w32.c
index 230ccc8de10..d81fdf3305d 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -150,6 +150,8 @@ typedef struct _PROCESS_MEMORY_COUNTERS_EX {
150typedef HRESULT (WINAPI * ShGetFolderPath_fn) 150typedef HRESULT (WINAPI * ShGetFolderPath_fn)
151 (IN HWND, IN int, IN HANDLE, IN DWORD, OUT char *); 151 (IN HWND, IN int, IN HANDLE, IN DWORD, OUT char *);
152 152
153Lisp_Object QCloaded_from;
154
153void globals_of_w32 (void); 155void globals_of_w32 (void);
154static DWORD get_rid (PSID); 156static DWORD get_rid (PSID);
155 157
@@ -5712,6 +5714,54 @@ sys_localtime (const time_t *t)
5712 return localtime (t); 5714 return localtime (t);
5713} 5715}
5714 5716
5717
5718
5719/* Delayed loading of libraries. */
5720
5721Lisp_Object Vlibrary_cache;
5722
5723/* The argument LIBRARIES is an alist that associates a symbol
5724 LIBRARY_ID, identifying an external DLL library known to Emacs, to
5725 a list of filenames under which the library is usually found. In
5726 most cases, the argument passed as LIBRARIES is the variable
5727 `dynamic-library-alist', which is initialized to a list of common
5728 library names. If the function loads the library successfully, it
5729 returns the handle of the DLL, and records the filename in the
5730 property :loaded-from of LIBRARY_ID; it returns NULL if the library
5731 could not be found, or when it was already loaded (because the
5732 handle is not recorded anywhere, and so is lost after use). It
5733 would be trivial to save the handle too in :loaded-from, but
5734 currently there's no use case for it. */
5735HMODULE
5736w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
5737{
5738 HMODULE library_dll = NULL;
5739
5740 CHECK_SYMBOL (library_id);
5741
5742 if (CONSP (libraries) && NILP (Fassq (library_id, Vlibrary_cache)))
5743 {
5744 Lisp_Object found = Qnil;
5745 Lisp_Object dlls = Fassq (library_id, libraries);
5746
5747 if (CONSP (dlls))
5748 for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
5749 {
5750 CHECK_STRING_CAR (dlls);
5751 if (library_dll = LoadLibrary (SDATA (XCAR (dlls))))
5752 {
5753 found = XCAR (dlls);
5754 break;
5755 }
5756 }
5757
5758 Fput (library_id, QCloaded_from, found);
5759 }
5760
5761 return library_dll;
5762}
5763
5764
5715static void 5765static void
5716check_windows_init_file (void) 5766check_windows_init_file (void)
5717{ 5767{
@@ -5910,6 +5960,12 @@ globals_of_w32 (void)
5910 get_process_times_fn = (GetProcessTimes_Proc) 5960 get_process_times_fn = (GetProcessTimes_Proc)
5911 GetProcAddress (kernel32, "GetProcessTimes"); 5961 GetProcAddress (kernel32, "GetProcessTimes");
5912 5962
5963 QCloaded_from = intern_c_string (":loaded-from");
5964 staticpro (&QCloaded_from);
5965
5966 Vlibrary_cache = Qnil;
5967 staticpro (&Vlibrary_cache);
5968
5913 g_b_init_is_windows_9x = 0; 5969 g_b_init_is_windows_9x = 0;
5914 g_b_init_open_process_token = 0; 5970 g_b_init_open_process_token = 0;
5915 g_b_init_get_token_information = 0; 5971 g_b_init_get_token_information = 0;
@@ -6178,7 +6234,7 @@ emacs_gnutls_pull (gnutls_transport_ptr_t p, void* buf, size_t sz)
6178 err = errno; /* Other errors are just passed on. */ 6234 err = errno; /* Other errors are just passed on. */
6179 } 6235 }
6180 6236
6181 gnutls_transport_set_errno (process->gnutls_state, err); 6237 emacs_gnutls_transport_set_errno (process->gnutls_state, err);
6182 6238
6183 return -1; 6239 return -1;
6184 } 6240 }
@@ -6197,8 +6253,8 @@ emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz)
6197 6253
6198 /* Negative bytes written means we got an error in errno. 6254 /* Negative bytes written means we got an error in errno.
6199 Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN. */ 6255 Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN. */
6200 gnutls_transport_set_errno (process->gnutls_state, 6256 emacs_gnutls_transport_set_errno (process->gnutls_state,
6201 errno == EWOULDBLOCK ? EAGAIN : errno); 6257 errno == EWOULDBLOCK ? EAGAIN : errno);
6202 6258
6203 return -1; 6259 return -1;
6204} 6260}
diff --git a/src/w32.h b/src/w32.h
index 4086c4190e1..f1915125c90 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -143,6 +143,9 @@ extern void syms_of_fontset (void);
143extern int _sys_read_ahead (int fd); 143extern int _sys_read_ahead (int fd);
144extern int _sys_wait_accept (int fd); 144extern int _sys_wait_accept (int fd);
145 145
146extern Lisp_Object Vlibrary_cache, QCloaded_from;
147extern HMODULE w32_delayed_load (Lisp_Object, Lisp_Object);
148
146#ifdef HAVE_GNUTLS 149#ifdef HAVE_GNUTLS
147#include <gnutls/gnutls.h> 150#include <gnutls/gnutls.h>
148 151