aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog33
-rw-r--r--src/gnutls.c325
-rw-r--r--src/gnutls.h5
-rw-r--r--src/image.c2
-rw-r--r--src/process.c8
-rw-r--r--src/w32.c6
-rw-r--r--src/w32fns.c15
-rw-r--r--src/w32font.c4
-rw-r--r--src/w32reg.c7
9 files changed, 201 insertions, 204 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 854c4987be5..c3926f6024b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,36 @@
12011-10-27 Chong Yidong <cyd@gnu.org>
2
3 * process.c (make_process): Set gnutls_state to NULL.
4
5 * gnutls.c (emacs_gnutls_deinit): Deinit the gnutls_state if it is
6 non-NULL, regardless of GNUTLS_INITSTAGE.
7 (Fgnutls_boot): Cleanups. Call emacs_gnutls_deinit if we signal
8 an error. Set process slots as soon as we allocate them.
9
10 * gnutls.h (GNUTLS_LOG, GNUTLS_LOG2): Fix macros.
11
122011-10-27 Chong Yidong <cyd@gnu.org>
13
14 * gnutls.c (emacs_gnutls_deinit): New function. Deallocate
15 credentials structures as well as calling gnutls_deinit.
16 (Fgnutls_deinit, Fgnutls_boot): Use it.
17
18 * process.c (make_process): Initialize GnuTLS credentials to NULL.
19 (deactivate_process): Call emacs_gnutls_deinit.
20
212011-10-27 Juanma Barranquero <lekktu@gmail.com>
22
23 * image.c (x_create_x_image_and_pixmap):
24 * w32.c (sys_rename, w32_delayed_load):
25 * w32font.c (fill_in_logfont):
26 * w32reg.c (x_get_string_resource): Silence compiler warnings.
27
282011-10-26 Juanma Barranquero <lekktu@gmail.com>
29
30 * w32fns.c (w32_default_color_map): New function,
31 extracted from Fw32_default_color_map.
32 (Fw32_default_color_map, Fx_open_connection): Use it. (Bug#9785)
33
12011-10-25 Paul Eggert <eggert@cs.ucla.edu> 342011-10-25 Paul Eggert <eggert@cs.ucla.edu>
2 35
3 * dispextern.h (Fcontrolling_tty_p): New decl (Bug#6649 part 2). 36 * dispextern.h (Fcontrolling_tty_p): New decl (Bug#6649 part 2).
diff --git a/src/gnutls.c b/src/gnutls.c
index 0743ef3f4ee..500f09432b1 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -464,6 +464,44 @@ gnutls_make_error (int err)
464 return make_number (err); 464 return make_number (err);
465} 465}
466 466
467Lisp_Object
468emacs_gnutls_deinit (Lisp_Object proc)
469{
470 int log_level;
471
472 CHECK_PROCESS (proc);
473
474 if (XPROCESS (proc)->gnutls_p == 0)
475 return Qnil;
476
477 log_level = XPROCESS (proc)->gnutls_log_level;
478
479 if (XPROCESS (proc)->gnutls_x509_cred)
480 {
481 GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
482 fn_gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
483 XPROCESS (proc)->gnutls_x509_cred = NULL;
484 }
485
486 if (XPROCESS (proc)->gnutls_anon_cred)
487 {
488 GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
489 fn_gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
490 XPROCESS (proc)->gnutls_anon_cred = NULL;
491 }
492
493 if (XPROCESS (proc)->gnutls_state)
494 {
495 fn_gnutls_deinit (XPROCESS (proc)->gnutls_state);
496 XPROCESS (proc)->gnutls_state = NULL;
497 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
498 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
499 }
500
501 XPROCESS (proc)->gnutls_p = 0;
502 return Qt;
503}
504
467DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0, 505DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
468 doc: /* Return the GnuTLS init stage of process PROC. 506 doc: /* Return the GnuTLS init stage of process PROC.
469See also `gnutls-boot'. */) 507See also `gnutls-boot'. */)
@@ -551,18 +589,7 @@ DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
551See also `gnutls-init'. */) 589See also `gnutls-init'. */)
552 (Lisp_Object proc) 590 (Lisp_Object proc)
553{ 591{
554 gnutls_session_t state; 592 return emacs_gnutls_deinit (proc);
555
556 CHECK_PROCESS (proc);
557 state = XPROCESS (proc)->gnutls_state;
558
559 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
560 {
561 fn_gnutls_deinit (state);
562 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
563 }
564
565 return Qt;
566} 593}
567 594
568DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, 595DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
@@ -622,7 +649,7 @@ emacs_gnutls_global_deinit (void)
622 649
623DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0, 650DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
624 doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST. 651 doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
625Currently only client mode is supported. Returns a success/failure 652Currently only client mode is supported. Return a success/failure
626value you can check with `gnutls-errorp'. 653value you can check with `gnutls-errorp'.
627 654
628TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'. 655TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
@@ -673,23 +700,13 @@ one trustfile (usually a CA bundle). */)
673 (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist) 700 (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
674{ 701{
675 int ret = GNUTLS_E_SUCCESS; 702 int ret = GNUTLS_E_SUCCESS;
676
677 int max_log_level = 0; 703 int max_log_level = 0;
678 704
679 /* TODO: GNUTLS_X509_FMT_DER is also an option. */
680 int file_format = GNUTLS_X509_FMT_PEM;
681
682 unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
683 gnutls_x509_crt_t gnutls_verify_cert;
684 unsigned int gnutls_verify_cert_list_size;
685 const gnutls_datum_t *gnutls_verify_cert_list;
686
687 gnutls_session_t state; 705 gnutls_session_t state;
688 gnutls_certificate_credentials_t x509_cred; 706 gnutls_certificate_credentials_t x509_cred = NULL;
689 gnutls_anon_client_credentials_t anon_cred; 707 gnutls_anon_client_credentials_t anon_cred = NULL;
690 Lisp_Object global_init; 708 Lisp_Object global_init;
691 char const *priority_string_ptr = "NORMAL"; /* default priority string. */ 709 char const *priority_string_ptr = "NORMAL"; /* default priority string. */
692 Lisp_Object tail;
693 unsigned int peer_verification; 710 unsigned int peer_verification;
694 char* c_hostname; 711 char* c_hostname;
695 712
@@ -701,7 +718,6 @@ one trustfile (usually a CA bundle). */)
701 /* Lisp_Object callbacks; */ 718 /* Lisp_Object callbacks; */
702 Lisp_Object loglevel; 719 Lisp_Object loglevel;
703 Lisp_Object hostname; 720 Lisp_Object hostname;
704 Lisp_Object verify_flags;
705 /* Lisp_Object verify_error; */ 721 /* Lisp_Object verify_error; */
706 Lisp_Object verify_hostname_error; 722 Lisp_Object verify_hostname_error;
707 Lisp_Object prime_bits; 723 Lisp_Object prime_bits;
@@ -716,26 +732,25 @@ one trustfile (usually a CA bundle). */)
716 return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED); 732 return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
717 } 733 }
718 734
735 if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
736 {
737 error ("Invalid GnuTLS credential type");
738 return gnutls_make_error (GNUTLS_EMACS_ERROR_INVALID_TYPE);
739 }
740
719 hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname); 741 hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname);
720 priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority); 742 priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority);
721 trustfiles = Fplist_get (proplist, QCgnutls_bootprop_trustfiles); 743 trustfiles = Fplist_get (proplist, QCgnutls_bootprop_trustfiles);
722 keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist); 744 keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist);
723 crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles); 745 crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);
724 /* callbacks = Fplist_get (proplist, QCgnutls_bootprop_callbacks); */
725 loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel); 746 loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel);
726 verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
727 /* verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error); */
728 verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error); 747 verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error);
729 prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits); 748 prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);
730 749
731 if (!STRINGP (hostname)) 750 if (!STRINGP (hostname))
732 error ("gnutls-boot: invalid :hostname parameter"); 751 error ("gnutls-boot: invalid :hostname parameter");
733
734 c_hostname = SSDATA (hostname); 752 c_hostname = SSDATA (hostname);
735 753
736 state = XPROCESS (proc)->gnutls_state;
737 XPROCESS (proc)->gnutls_p = 1;
738
739 if (NUMBERP (loglevel)) 754 if (NUMBERP (loglevel))
740 { 755 {
741 fn_gnutls_global_set_log_function (gnutls_log_function); 756 fn_gnutls_global_set_log_function (gnutls_log_function);
@@ -749,82 +764,56 @@ one trustfile (usually a CA bundle). */)
749 if (! NILP (Fgnutls_errorp (global_init))) 764 if (! NILP (Fgnutls_errorp (global_init)))
750 return global_init; 765 return global_init;
751 766
752 /* deinit and free resources. */ 767 /* Before allocating new credentials, deallocate any credentials
753 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_CRED_ALLOC) 768 that PROC might already have. */
754 { 769 emacs_gnutls_deinit (proc);
755 GNUTLS_LOG (1, max_log_level, "deallocating credentials");
756
757 if (EQ (type, Qgnutls_x509pki))
758 {
759 GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
760 x509_cred = XPROCESS (proc)->gnutls_x509_cred;
761 fn_gnutls_certificate_free_credentials (x509_cred);
762 }
763 else if (EQ (type, Qgnutls_anon))
764 {
765 GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
766 anon_cred = XPROCESS (proc)->gnutls_anon_cred;
767 fn_gnutls_anon_free_client_credentials (anon_cred);
768 }
769 else
770 {
771 error ("unknown credential type");
772 ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
773 }
774
775 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
776 {
777 GNUTLS_LOG (1, max_log_level, "deallocating x509 credentials");
778 Fgnutls_deinit (proc);
779 }
780 }
781 770
771 /* Mark PROC as a GnuTLS process. */
772 XPROCESS (proc)->gnutls_p = 1;
773 XPROCESS (proc)->gnutls_state = NULL;
774 XPROCESS (proc)->gnutls_x509_cred = NULL;
775 XPROCESS (proc)->gnutls_anon_cred = NULL;
776 XPROCESS (proc)->gnutls_cred_type = type;
782 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY; 777 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
783 778
784 GNUTLS_LOG (1, max_log_level, "allocating credentials"); 779 GNUTLS_LOG (1, max_log_level, "allocating credentials");
785
786 if (EQ (type, Qgnutls_x509pki)) 780 if (EQ (type, Qgnutls_x509pki))
787 { 781 {
782 Lisp_Object verify_flags;
783 unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
784
788 GNUTLS_LOG (2, max_log_level, "allocating x509 credentials"); 785 GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
789 x509_cred = XPROCESS (proc)->gnutls_x509_cred;
790 fn_gnutls_certificate_allocate_credentials (&x509_cred); 786 fn_gnutls_certificate_allocate_credentials (&x509_cred);
787 XPROCESS (proc)->gnutls_x509_cred = x509_cred;
791 788
789 verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
792 if (NUMBERP (verify_flags)) 790 if (NUMBERP (verify_flags))
793 { 791 {
794 gnutls_verify_flags = XINT (verify_flags); 792 gnutls_verify_flags = XINT (verify_flags);
795 GNUTLS_LOG (2, max_log_level, "setting verification flags"); 793 GNUTLS_LOG (2, max_log_level, "setting verification flags");
796 } 794 }
797 else if (NILP (verify_flags)) 795 else if (NILP (verify_flags))
798 { 796 GNUTLS_LOG (2, max_log_level, "using default verification flags");
799 /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */
800 GNUTLS_LOG (2, max_log_level, "using default verification flags");
801 }
802 else 797 else
803 { 798 GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
804 /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */ 799
805 GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
806 }
807 fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags); 800 fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
808 } 801 }
809 else if (EQ (type, Qgnutls_anon)) 802 else /* Qgnutls_anon: */
810 { 803 {
811 GNUTLS_LOG (2, max_log_level, "allocating anon credentials"); 804 GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
812 anon_cred = XPROCESS (proc)->gnutls_anon_cred;
813 fn_gnutls_anon_allocate_client_credentials (&anon_cred); 805 fn_gnutls_anon_allocate_client_credentials (&anon_cred);
814 } 806 XPROCESS (proc)->gnutls_anon_cred = anon_cred;
815 else
816 {
817 error ("unknown credential type");
818 ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
819 } 807 }
820 808
821 if (ret < GNUTLS_E_SUCCESS)
822 return gnutls_make_error (ret);
823
824 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC; 809 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
825 810
826 if (EQ (type, Qgnutls_x509pki)) 811 if (EQ (type, Qgnutls_x509pki))
827 { 812 {
813 /* TODO: GNUTLS_X509_FMT_DER is also an option. */
814 int file_format = GNUTLS_X509_FMT_PEM;
815 Lisp_Object tail;
816
828 for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail)) 817 for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
829 { 818 {
830 Lisp_Object trustfile = Fcar (tail); 819 Lisp_Object trustfile = Fcar (tail);
@@ -842,8 +831,8 @@ one trustfile (usually a CA bundle). */)
842 } 831 }
843 else 832 else
844 { 833 {
845 error ("Sorry, GnuTLS can't use non-string trustfile %s", 834 emacs_gnutls_deinit (proc);
846 SDATA (trustfile)); 835 error ("Invalid trustfile");
847 } 836 }
848 } 837 }
849 838
@@ -855,17 +844,15 @@ one trustfile (usually a CA bundle). */)
855 GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ", 844 GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
856 SSDATA (crlfile)); 845 SSDATA (crlfile));
857 ret = fn_gnutls_certificate_set_x509_crl_file 846 ret = fn_gnutls_certificate_set_x509_crl_file
858 (x509_cred, 847 (x509_cred, SSDATA (crlfile), file_format);
859 SSDATA (crlfile),
860 file_format);
861 848
862 if (ret < GNUTLS_E_SUCCESS) 849 if (ret < GNUTLS_E_SUCCESS)
863 return gnutls_make_error (ret); 850 return gnutls_make_error (ret);
864 } 851 }
865 else 852 else
866 { 853 {
867 error ("Sorry, GnuTLS can't use non-string CRL file %s", 854 emacs_gnutls_deinit (proc);
868 SDATA (crlfile)); 855 error ("Invalid CRL file");
869 } 856 }
870 } 857 }
871 858
@@ -880,45 +867,31 @@ one trustfile (usually a CA bundle). */)
880 GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ", 867 GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
881 SSDATA (certfile)); 868 SSDATA (certfile));
882 ret = fn_gnutls_certificate_set_x509_key_file 869 ret = fn_gnutls_certificate_set_x509_key_file
883 (x509_cred, 870 (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
884 SSDATA (certfile),
885 SSDATA (keyfile),
886 file_format);
887 871
888 if (ret < GNUTLS_E_SUCCESS) 872 if (ret < GNUTLS_E_SUCCESS)
889 return gnutls_make_error (ret); 873 return gnutls_make_error (ret);
890 } 874 }
891 else 875 else
892 { 876 {
893 if (STRINGP (keyfile)) 877 emacs_gnutls_deinit (proc);
894 error ("Sorry, GnuTLS can't use non-string client cert file %s", 878 error (STRINGP (keyfile) ? "Invalid client cert file"
895 SDATA (certfile)); 879 : "Invalid client key file");
896 else
897 error ("Sorry, GnuTLS can't use non-string client key file %s",
898 SDATA (keyfile));
899 } 880 }
900 } 881 }
901 } 882 }
902 883
903 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES; 884 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
904
905 GNUTLS_LOG (1, max_log_level, "gnutls callbacks"); 885 GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
906
907 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS; 886 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
908 887
909#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY 888 /* Call gnutls_init here: */
910#else
911#endif
912 889
913 GNUTLS_LOG (1, max_log_level, "gnutls_init"); 890 GNUTLS_LOG (1, max_log_level, "gnutls_init");
914
915 ret = fn_gnutls_init (&state, GNUTLS_CLIENT); 891 ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
916 892 XPROCESS (proc)->gnutls_state = state;
917 if (ret < GNUTLS_E_SUCCESS) 893 if (ret < GNUTLS_E_SUCCESS)
918 return gnutls_make_error (ret); 894 return gnutls_make_error (ret);
919
920 XPROCESS (proc)->gnutls_state = state;
921
922 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT; 895 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
923 896
924 if (STRINGP (priority_string)) 897 if (STRINGP (priority_string))
@@ -934,46 +907,25 @@ one trustfile (usually a CA bundle). */)
934 } 907 }
935 908
936 GNUTLS_LOG (1, max_log_level, "setting the priority string"); 909 GNUTLS_LOG (1, max_log_level, "setting the priority string");
937
938 ret = fn_gnutls_priority_set_direct (state, 910 ret = fn_gnutls_priority_set_direct (state,
939 priority_string_ptr, 911 priority_string_ptr,
940 NULL); 912 NULL);
941
942 if (ret < GNUTLS_E_SUCCESS) 913 if (ret < GNUTLS_E_SUCCESS)
943 return gnutls_make_error (ret); 914 return gnutls_make_error (ret);
944 915
945 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY; 916 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
946 917
947 if (!EQ (prime_bits, Qnil)) 918 if (INTEGERP (prime_bits))
948 { 919 fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
949 fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
950 }
951
952 if (EQ (type, Qgnutls_x509pki))
953 {
954 ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
955 }
956 else if (EQ (type, Qgnutls_anon))
957 {
958 ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
959 }
960 else
961 {
962 error ("unknown credential type");
963 ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
964 }
965 920
921 ret = EQ (type, Qgnutls_x509pki)
922 ? fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
923 : fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
966 if (ret < GNUTLS_E_SUCCESS) 924 if (ret < GNUTLS_E_SUCCESS)
967 return gnutls_make_error (ret); 925 return gnutls_make_error (ret);
968 926
969 XPROCESS (proc)->gnutls_anon_cred = anon_cred;
970 XPROCESS (proc)->gnutls_x509_cred = x509_cred;
971 XPROCESS (proc)->gnutls_cred_type = type;
972
973 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET; 927 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
974
975 ret = emacs_gnutls_handshake (XPROCESS (proc)); 928 ret = emacs_gnutls_handshake (XPROCESS (proc));
976
977 if (ret < GNUTLS_E_SUCCESS) 929 if (ret < GNUTLS_E_SUCCESS)
978 return gnutls_make_error (ret); 930 return gnutls_make_error (ret);
979 931
@@ -984,69 +936,71 @@ one trustfile (usually a CA bundle). */)
984 gnutls_x509_crt_check_hostname() against :hostname. */ 936 gnutls_x509_crt_check_hostname() against :hostname. */
985 937
986 ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification); 938 ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
987
988 if (ret < GNUTLS_E_SUCCESS) 939 if (ret < GNUTLS_E_SUCCESS)
989 return gnutls_make_error (ret); 940 return gnutls_make_error (ret);
990 941
991 if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID) 942 if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
992 message ("%s certificate could not be verified.", 943 message ("%s certificate could not be verified.", c_hostname);
993 c_hostname); 944
994 945 if (peer_verification & GNUTLS_CERT_REVOKED)
995 if (peer_verification & GNUTLS_CERT_REVOKED) 946 GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
996 GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):", 947 c_hostname);
997 c_hostname); 948
998 949 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
999 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND) 950 GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
1000 GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:", 951 c_hostname);
1001 c_hostname); 952
1002 953 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
1003 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA) 954 GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
1004 GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:", 955 c_hostname);
1005 c_hostname); 956
1006 957 if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
1007 if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM) 958 GNUTLS_LOG2 (1, max_log_level,
1008 GNUTLS_LOG2 (1, max_log_level, 959 "certificate was signed with an insecure algorithm:",
1009 "certificate was signed with an insecure algorithm:", 960 c_hostname);
1010 c_hostname); 961
1011 962 if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
1012 if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED) 963 GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
1013 GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:", 964 c_hostname);
1014 c_hostname); 965
1015 966 if (peer_verification & GNUTLS_CERT_EXPIRED)
1016 if (peer_verification & GNUTLS_CERT_EXPIRED) 967 GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
1017 GNUTLS_LOG2 (1, max_log_level, "certificate has expired:", 968 c_hostname);
1018 c_hostname); 969
1019 970 if (peer_verification != 0)
1020 if (peer_verification != 0) 971 {
1021 { 972 if (NILP (verify_hostname_error))
1022 if (NILP (verify_hostname_error)) 973 GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
1023 { 974 c_hostname);
1024 GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:", 975 else
1025 c_hostname); 976 {
1026 } 977 emacs_gnutls_deinit (proc);
1027 else 978 error ("Certificate validation failed %s, verification code %d",
1028 { 979 c_hostname, peer_verification);
1029 error ("Certificate validation failed %s, verification code %d", 980 }
1030 c_hostname, peer_verification); 981 }
1031 }
1032 }
1033 982
1034 /* Up to here the process is the same for X.509 certificates and 983 /* Up to here the process is the same for X.509 certificates and
1035 OpenPGP keys. From now on X.509 certificates are assumed. This 984 OpenPGP keys. From now on X.509 certificates are assumed. This
1036 can be easily extended to work with openpgp keys as well. */ 985 can be easily extended to work with openpgp keys as well. */
1037 if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509) 986 if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
1038 { 987 {
1039 ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert); 988 gnutls_x509_crt_t gnutls_verify_cert;
989 const gnutls_datum_t *gnutls_verify_cert_list;
990 unsigned int gnutls_verify_cert_list_size;
1040 991
992 ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
1041 if (ret < GNUTLS_E_SUCCESS) 993 if (ret < GNUTLS_E_SUCCESS)
1042 return gnutls_make_error (ret); 994 return gnutls_make_error (ret);
1043 995
1044 gnutls_verify_cert_list = 996 gnutls_verify_cert_list =
1045 fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size); 997 fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
1046 998
1047 if (NULL == gnutls_verify_cert_list) 999 if (gnutls_verify_cert_list == NULL)
1048 { 1000 {
1049 error ("No x509 certificate was found!\n"); 1001 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1002 emacs_gnutls_deinit (proc);
1003 error ("No x509 certificate was found\n");
1050 } 1004 }
1051 1005
1052 /* We only check the first certificate in the given chain. */ 1006 /* We only check the first certificate in the given chain. */
@@ -1063,18 +1017,15 @@ one trustfile (usually a CA bundle). */)
1063 if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname)) 1017 if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
1064 { 1018 {
1065 if (NILP (verify_hostname_error)) 1019 if (NILP (verify_hostname_error))
1066 { 1020 GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
1067 GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:", 1021 c_hostname);
1068 c_hostname);
1069 }
1070 else 1022 else
1071 { 1023 {
1072 fn_gnutls_x509_crt_deinit (gnutls_verify_cert); 1024 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1073 error ("The x509 certificate does not match \"%s\"", 1025 emacs_gnutls_deinit (proc);
1074 c_hostname); 1026 error ("The x509 certificate does not match \"%s\"", c_hostname);
1075 } 1027 }
1076 } 1028 }
1077
1078 fn_gnutls_x509_crt_deinit (gnutls_verify_cert); 1029 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1079 } 1030 }
1080 1031
diff --git a/src/gnutls.h b/src/gnutls.h
index e2a9bc9eaea..076e9fdba9c 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -49,9 +49,9 @@ typedef enum
49 49
50#define GNUTLS_PROCESS_USABLE(proc) (GNUTLS_INITSTAGE(proc) >= GNUTLS_STAGE_READY) 50#define GNUTLS_PROCESS_USABLE(proc) (GNUTLS_INITSTAGE(proc) >= GNUTLS_STAGE_READY)
51 51
52#define GNUTLS_LOG(level, max, string) if (level <= max) { gnutls_log_function (level, "(Emacs) " string); } 52#define GNUTLS_LOG(level, max, string) do { if (level <= max) { gnutls_log_function (level, "(Emacs) " string); } } while (0)
53 53
54#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) do { if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } } while (0)
55 55
56extern EMACS_INT 56extern EMACS_INT
57emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte); 57emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte);
@@ -60,6 +60,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte);
60 60
61extern int emacs_gnutls_record_check_pending (gnutls_session_t state); 61extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
62extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); 62extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
63extern Lisp_Object emacs_gnutls_deinit (Lisp_Object);
63 64
64extern void syms_of_gnutls (void); 65extern void syms_of_gnutls (void);
65 66
diff --git a/src/image.c b/src/image.c
index ef72745a72f..14c74f10607 100644
--- a/src/image.c
+++ b/src/image.c
@@ -2015,7 +2015,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
2015 /* Bitmaps with a depth less than 16 need a palette. */ 2015 /* Bitmaps with a depth less than 16 need a palette. */
2016 /* BITMAPINFO structure already contains the first RGBQUAD. */ 2016 /* BITMAPINFO structure already contains the first RGBQUAD. */
2017 if (depth < 16) 2017 if (depth < 16)
2018 palette_colors = 1 << depth - 1; 2018 palette_colors = 1 << (depth - 1);
2019 2019
2020 *ximg = xmalloc (sizeof (XImage) + palette_colors * sizeof (RGBQUAD)); 2020 *ximg = xmalloc (sizeof (XImage) + palette_colors * sizeof (RGBQUAD));
2021 2021
diff --git a/src/process.c b/src/process.c
index 90ad9c21681..dc37ec5f961 100644
--- a/src/process.c
+++ b/src/process.c
@@ -642,6 +642,9 @@ make_process (Lisp_Object name)
642 p->gnutls_initstage = GNUTLS_STAGE_EMPTY; 642 p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
643 p->gnutls_log_level = 0; 643 p->gnutls_log_level = 0;
644 p->gnutls_p = 0; 644 p->gnutls_p = 0;
645 p->gnutls_state = NULL;
646 p->gnutls_x509_cred = NULL;
647 p->gnutls_anon_cred = NULL;
645#endif 648#endif
646 649
647 /* If name is already in use, modify it until it is unused. */ 650 /* If name is already in use, modify it until it is unused. */
@@ -3867,6 +3870,11 @@ deactivate_process (Lisp_Object proc)
3867 register int inchannel, outchannel; 3870 register int inchannel, outchannel;
3868 register struct Lisp_Process *p = XPROCESS (proc); 3871 register struct Lisp_Process *p = XPROCESS (proc);
3869 3872
3873#ifdef HAVE_GNUTLS
3874 /* Delete GnuTLS structures in PROC, if any. */
3875 emacs_gnutls_deinit (proc);
3876#endif /* HAVE_GNUTLS */
3877
3870 inchannel = p->infd; 3878 inchannel = p->infd;
3871 outchannel = p->outfd; 3879 outchannel = p->outfd;
3872 3880
diff --git a/src/w32.c b/src/w32.c
index 91893ddfc61..42546fc8d49 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -2892,12 +2892,12 @@ sys_rename (const char * oldname, const char * newname)
2892 int i = 0; 2892 int i = 0;
2893 2893
2894 oldname = map_w32_filename (oldname, NULL); 2894 oldname = map_w32_filename (oldname, NULL);
2895 if (o = strrchr (oldname, '\\')) 2895 if ((o = strrchr (oldname, '\\')))
2896 o++; 2896 o++;
2897 else 2897 else
2898 o = (char *) oldname; 2898 o = (char *) oldname;
2899 2899
2900 if (p = strrchr (temp, '\\')) 2900 if ((p = strrchr (temp, '\\')))
2901 p++; 2901 p++;
2902 else 2902 else
2903 p = temp; 2903 p = temp;
@@ -5756,7 +5756,7 @@ w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
5756 for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls)) 5756 for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
5757 { 5757 {
5758 CHECK_STRING_CAR (dlls); 5758 CHECK_STRING_CAR (dlls);
5759 if (library_dll = LoadLibrary (SDATA (XCAR (dlls)))) 5759 if ((library_dll = LoadLibrary (SDATA (XCAR (dlls)))))
5760 { 5760 {
5761 found = XCAR (dlls); 5761 found = XCAR (dlls);
5762 break; 5762 break;
diff --git a/src/w32fns.c b/src/w32fns.c
index f48e5764b4c..2ecd6e91533 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -635,9 +635,8 @@ colormap_t w32_color_map[] =
635 {"LightGreen" , PALETTERGB (144,238,144)}, 635 {"LightGreen" , PALETTERGB (144,238,144)},
636}; 636};
637 637
638DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map, 638static Lisp_Object
639 0, 0, 0, doc: /* Return the default color map. */) 639w32_default_color_map (void)
640 (void)
641{ 640{
642 int i; 641 int i;
643 colormap_t *pc = w32_color_map; 642 colormap_t *pc = w32_color_map;
@@ -658,6 +657,13 @@ DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
658 return (cmap); 657 return (cmap);
659} 658}
660 659
660DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
661 0, 0, 0, doc: /* Return the default color map. */)
662 (void)
663{
664 return w32_default_color_map ();
665}
666
661static Lisp_Object 667static Lisp_Object
662w32_color_map_lookup (char *colorname) 668w32_color_map_lookup (char *colorname)
663{ 669{
@@ -683,7 +689,6 @@ w32_color_map_lookup (char *colorname)
683 QUIT; 689 QUIT;
684 } 690 }
685 691
686
687 UNBLOCK_INPUT; 692 UNBLOCK_INPUT;
688 693
689 return ret; 694 return ret;
@@ -4768,7 +4773,7 @@ terminate Emacs if we can't open the connection.
4768 UNGCPRO; 4773 UNGCPRO;
4769 } 4774 }
4770 if (NILP (Vw32_color_map)) 4775 if (NILP (Vw32_color_map))
4771 Vw32_color_map = Fw32_default_color_map (); 4776 Vw32_color_map = w32_default_color_map ();
4772 4777
4773 /* Merge in system logical colors. */ 4778 /* Merge in system logical colors. */
4774 add_system_logical_colors_to_map (&Vw32_color_map); 4779 add_system_logical_colors_to_map (&Vw32_color_map);
diff --git a/src/w32font.c b/src/w32font.c
index 985370c15c1..f47b7a46b1e 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -1916,10 +1916,10 @@ fill_in_logfont (FRAME_PTR f, LOGFONT *logfont, Lisp_Object font_spec)
1916 int spacing = XINT (tmp); 1916 int spacing = XINT (tmp);
1917 if (spacing < FONT_SPACING_MONO) 1917 if (spacing < FONT_SPACING_MONO)
1918 logfont->lfPitchAndFamily 1918 logfont->lfPitchAndFamily
1919 = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH; 1919 = (logfont->lfPitchAndFamily & 0xF0) | VARIABLE_PITCH;
1920 else 1920 else
1921 logfont->lfPitchAndFamily 1921 logfont->lfPitchAndFamily
1922 = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH; 1922 = (logfont->lfPitchAndFamily & 0xF0) | FIXED_PITCH;
1923 } 1923 }
1924 1924
1925 /* Process EXTRA info. */ 1925 /* Process EXTRA info. */
diff --git a/src/w32reg.c b/src/w32reg.c
index e1465be9e44..18374431062 100644
--- a/src/w32reg.c
+++ b/src/w32reg.c
@@ -147,9 +147,9 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class)
147 { 147 {
148 char *resource; 148 char *resource;
149 149
150 if (resource = w32_get_rdb_resource (rdb, name)) 150 if ((resource = w32_get_rdb_resource (rdb, name)))
151 return resource; 151 return resource;
152 if (resource = w32_get_rdb_resource (rdb, class)) 152 if ((resource = w32_get_rdb_resource (rdb, class)))
153 return resource; 153 return resource;
154 } 154 }
155 155
@@ -157,6 +157,5 @@ x_get_string_resource (XrmDatabase rdb, char *name, char *class)
157 /* --quick was passed, so this is a no-op. */ 157 /* --quick was passed, so this is a no-op. */
158 return NULL; 158 return NULL;
159 159
160 return (w32_get_string_resource (name, class, REG_SZ)); 160 return w32_get_string_resource (name, class, REG_SZ);
161} 161}
162