comparison modules/ldap/eldap.c @ 5125:b5df3737028a ben-lisp-object

merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents d1247f3cc363 4aebb0131297
children a9c41067dd88
comparison
equal deleted inserted replaced
5124:623d57b7fbe8 5125:b5df3737028a
1 /* LDAP client interface for XEmacs. 1 /* LDAP client interface for XEmacs.
2 Copyright (C) 1998 Free Software Foundation, Inc. 2 Copyright (C) 1998 Free Software Foundation, Inc.
3 Copyright (C) 2004, 2005 Ben Wing. 3 Copyright (C) 2004, 2005, 2010 Ben Wing.
4 4
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
97 #else 97 #else
98 ldap_err = ld->ld_errno; 98 ldap_err = ld->ld_errno;
99 #endif 99 #endif
100 } 100 }
101 invalid_operation ("LDAP error", 101 invalid_operation ("LDAP error",
102 build_ext_string (ldap_err2string (ldap_err), Qnative)); 102 build_extstring (ldap_err2string (ldap_err), Qnative));
103 } 103 }
104 104
105 105
106 /************************************************************************/ 106 /************************************************************************/
107 /* ldap lrecord basic functions */ 107 /* ldap lrecord basic functions */
132 if (print_readably) 132 if (print_readably)
133 printing_unreadable_object ("#<ldap %s>", XSTRING_DATA (ldap->host)); 133 printing_unreadable_object ("#<ldap %s>", XSTRING_DATA (ldap->host));
134 134
135 write_fmt_string_lisp (printcharfun, "#<ldap %S", 1, ldap->host); 135 write_fmt_string_lisp (printcharfun, "#<ldap %S", 1, ldap->host);
136 if (!ldap->ld) 136 if (!ldap->ld)
137 write_c_string (printcharfun,"(dead) "); 137 write_ascstring (printcharfun,"(dead) ");
138 write_fmt_string (printcharfun, " 0x%lx>", (long)ldap); 138 write_fmt_string (printcharfun, " 0x%lx>", (long)ldap);
139 } 139 }
140 140
141 static Lisp_LDAP * 141 static Lisp_LDAP *
142 allocate_ldap (void) 142 allocate_ldap (void)
147 ldap->host = Qnil; 147 ldap->host = Qnil;
148 return ldap; 148 return ldap;
149 } 149 }
150 150
151 static void 151 static void
152 finalize_ldap (void *header, int for_disksave) 152 finalize_ldap (void *header)
153 { 153 {
154 Lisp_LDAP *ldap = (Lisp_LDAP *) header; 154 Lisp_LDAP *ldap = (Lisp_LDAP *) header;
155
156 if (for_disksave)
157 invalid_operation ("Can't dump an emacs containing LDAP objects",
158 make_ldap (ldap));
159 155
160 if (ldap->ld) 156 if (ldap->ld)
161 ldap_unbind (ldap->ld); 157 ldap_unbind (ldap->ld);
162 ldap->ld = NULL; 158 ldap->ld = NULL;
163 } 159 }
261 } 257 }
262 /* Bind DN */ 258 /* Bind DN */
263 else if (EQ (keyword, Qbinddn)) 259 else if (EQ (keyword, Qbinddn))
264 { 260 {
265 CHECK_STRING (value); 261 CHECK_STRING (value);
266 LISP_STRING_TO_EXTERNAL (value, ldap_binddn, Qnative); 262 ldap_binddn = LISP_STRING_TO_EXTERNAL (value, Qnative);
267 } 263 }
268 /* Password */ 264 /* Password */
269 else if (EQ (keyword, Qpasswd)) 265 else if (EQ (keyword, Qpasswd))
270 { 266 {
271 CHECK_STRING (value); 267 CHECK_STRING (value);
272 LISP_STRING_TO_EXTERNAL (value, ldap_password, Qnative); 268 ldap_password = LISP_STRING_TO_EXTERNAL (value, Qnative);
273 } 269 }
274 /* Deref */ 270 /* Deref */
275 else if (EQ (keyword, Qderef)) 271 else if (EQ (keyword, Qderef))
276 { 272 {
277 if (EQ (value, Qnever)) 273 if (EQ (value, Qnever))
305 ldap_port = ldap_default_port; 301 ldap_port = ldap_default_port;
306 } 302 }
307 303
308 /* Connect to the server and bind */ 304 /* Connect to the server and bind */
309 slow_down_interrupts (); 305 slow_down_interrupts ();
310 ld = ldap_open (NEW_LISP_STRING_TO_EXTERNAL (host, Qnative), ldap_port); 306 ld = ldap_open (LISP_STRING_TO_EXTERNAL (host, Qnative), ldap_port);
311 speed_up_interrupts (); 307 speed_up_interrupts ();
312 308
313 if (ld == NULL ) 309 if (ld == NULL )
314 report_process_error ("Failed connecting to host", host); 310 report_process_error ("Failed connecting to host", host);
315 311
344 340
345 err = ldap_bind_s (ld, ldap_binddn, ldap_password, ldap_auth); 341 err = ldap_bind_s (ld, ldap_binddn, ldap_password, ldap_auth);
346 if (err != LDAP_SUCCESS) 342 if (err != LDAP_SUCCESS)
347 { 343 {
348 signal_error (Qprocess_error, "Failed binding to the server", 344 signal_error (Qprocess_error, "Failed binding to the server",
349 build_ext_string (ldap_err2string (err), Qnative)); 345 build_extstring (ldap_err2string (err), Qnative));
350 } 346 }
351 347
352 ldap = allocate_ldap (); 348 ldap = allocate_ldap ();
353 ldap->ld = ld; 349 ldap->ld = ld;
354 ldap->host = host; 350 ldap->host = host;
484 i = 0; 480 i = 0;
485 { 481 {
486 EXTERNAL_LIST_LOOP_2 (current, attrs) 482 EXTERNAL_LIST_LOOP_2 (current, attrs)
487 { 483 {
488 CHECK_STRING (current); 484 CHECK_STRING (current);
489 LISP_STRING_TO_EXTERNAL (current, ldap_attributes[i], Qnative); 485 ldap_attributes[i] = LISP_STRING_TO_EXTERNAL (current, Qnative);
490 ++i; 486 ++i;
491 } 487 }
492 } 488 }
493 ldap_attributes[i] = NULL; 489 ldap_attributes[i] = NULL;
494 } 490 }
496 /* Attributes only ? */ 492 /* Attributes only ? */
497 CHECK_SYMBOL (attrsonly); 493 CHECK_SYMBOL (attrsonly);
498 494
499 /* Perform the search */ 495 /* Perform the search */
500 bs = NILP (base) ? (Extbyte *) "" : 496 bs = NILP (base) ? (Extbyte *) "" :
501 NEW_LISP_STRING_TO_EXTERNAL (base, Qnative); 497 LISP_STRING_TO_EXTERNAL (base, Qnative);
502 filt = NILP (filter) ? (Extbyte *) "" : 498 filt = NILP (filter) ? (Extbyte *) "" :
503 NEW_LISP_STRING_TO_EXTERNAL (filter, Qnative); 499 LISP_STRING_TO_EXTERNAL (filter, Qnative);
504 if (ldap_search (ld, bs, ldap_scope, filt, ldap_attributes, 500 if (ldap_search (ld, bs, ldap_scope, filt, ldap_attributes,
505 NILP (attrsonly) ? 0 : 1) 501 NILP (attrsonly) ? 0 : 1)
506 == -1) 502 == -1)
507 { 503 {
508 signal_ldap_error (ld, NULL, 0); 504 signal_ldap_error (ld, NULL, 0);
533 if (! NILP (withdn)) 529 if (! NILP (withdn))
534 { 530 {
535 dn = ldap_get_dn (ld, e); 531 dn = ldap_get_dn (ld, e);
536 if (dn == NULL) 532 if (dn == NULL)
537 signal_ldap_error (ld, e, 0); 533 signal_ldap_error (ld, e, 0);
538 entry = Fcons (build_ext_string (dn, Qnative), Qnil); 534 entry = Fcons (build_extstring (dn, Qnative), Qnil);
539 } 535 }
540 for (a = ldap_first_attribute (ld, e, &ptr); 536 for (a = ldap_first_attribute (ld, e, &ptr);
541 a != NULL; 537 a != NULL;
542 a = ldap_next_attribute (ld, e, ptr)) 538 a = ldap_next_attribute (ld, e, ptr))
543 { 539 {
544 list = Fcons (build_ext_string (a, Qnative), Qnil); 540 list = Fcons (build_extstring (a, Qnative), Qnil);
545 unwind.vals = ldap_get_values_len (ld, e, a); 541 unwind.vals = ldap_get_values_len (ld, e, a);
546 if (unwind.vals != NULL) 542 if (unwind.vals != NULL)
547 { 543 {
548 for (i = 0; unwind.vals[i] != NULL; i++) 544 for (i = 0; unwind.vals[i] != NULL; i++)
549 { 545 {
550 list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val, 546 list = Fcons (make_extstring ((Extbyte *) unwind.vals[i]->bv_val,
551 unwind.vals[i]->bv_len, 547 unwind.vals[i]->bv_len,
552 Qnative), 548 Qnative),
553 list); 549 list);
554 } 550 }
555 } 551 }
643 EXTERNAL_LIST_LOOP_2 (current, entry) 639 EXTERNAL_LIST_LOOP_2 (current, entry)
644 { 640 {
645 CHECK_CONS (current); 641 CHECK_CONS (current);
646 CHECK_STRING (XCAR (current)); 642 CHECK_STRING (XCAR (current));
647 ldap_mods_ptrs[i] = &(ldap_mods[i]); 643 ldap_mods_ptrs[i] = &(ldap_mods[i]);
648 LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, 644 ldap_mods[i].mod_type =
649 Qnative); 645 LISP_STRING_TO_EXTERNAL (XCAR (current), Qnative);
650 ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES; 646 ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES;
651 values = XCDR (current); 647 values = XCDR (current);
652 if (CONSP (values)) 648 if (CONSP (values))
653 { 649 {
654 len = (Elemcount) XINT (Flength (values)); 650 len = (Elemcount) XINT (Flength (values));
685 } 681 }
686 i++; 682 i++;
687 } 683 }
688 } 684 }
689 ldap_mods_ptrs[i] = NULL; 685 ldap_mods_ptrs[i] = NULL;
690 rc = ldap_add_s (ld, NEW_LISP_STRING_TO_EXTERNAL (dn, Qnative), 686 rc = ldap_add_s (ld, LISP_STRING_TO_EXTERNAL (dn, Qnative),
691 ldap_mods_ptrs); 687 ldap_mods_ptrs);
692 if (rc != LDAP_SUCCESS) 688 if (rc != LDAP_SUCCESS)
693 signal_ldap_error (ld, NULL, rc); 689 signal_ldap_error (ld, NULL, rc);
694 690
695 UNGCPRO; 691 UNGCPRO;
752 ldap_mods[i].mod_op |= LDAP_MOD_REPLACE; 748 ldap_mods[i].mod_op |= LDAP_MOD_REPLACE;
753 else 749 else
754 invalid_constant ("Invalid LDAP modification type", mod_op); 750 invalid_constant ("Invalid LDAP modification type", mod_op);
755 current = XCDR (current); 751 current = XCDR (current);
756 CHECK_STRING (XCAR (current)); 752 CHECK_STRING (XCAR (current));
757 LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, 753 ldap_mods[i].mod_type =
758 Qnative); 754 LISP_STRING_TO_EXTERNAL (XCAR (current), Qnative);
759 values = XCDR (current); 755 values = XCDR (current);
760 len = (Elemcount) XINT (Flength (values)); 756 len = (Elemcount) XINT (Flength (values));
761 bervals = alloca_array (struct berval, len); 757 bervals = alloca_array (struct berval, len);
762 ldap_mods[i].mod_vals.modv_bvals = 758 ldap_mods[i].mod_vals.modv_bvals =
763 alloca_array (struct berval *, 1 + len); 759 alloca_array (struct berval *, 1 + len);
777 i++; 773 i++;
778 } 774 }
779 } 775 }
780 } 776 }
781 ldap_mods_ptrs[i] = NULL; 777 ldap_mods_ptrs[i] = NULL;
782 rc = ldap_modify_s (ld, NEW_LISP_STRING_TO_EXTERNAL (dn, Qnative), 778 rc = ldap_modify_s (ld, LISP_STRING_TO_EXTERNAL (dn, Qnative),
783 ldap_mods_ptrs); 779 ldap_mods_ptrs);
784 if (rc != LDAP_SUCCESS) 780 if (rc != LDAP_SUCCESS)
785 signal_ldap_error (ld, NULL, rc); 781 signal_ldap_error (ld, NULL, rc);
786 782
787 UNGCPRO; 783 UNGCPRO;
802 /* Check parameters */ 798 /* Check parameters */
803 CHECK_LIVE_LDAP (ldap); 799 CHECK_LIVE_LDAP (ldap);
804 ld = XLDAP (ldap)->ld; 800 ld = XLDAP (ldap)->ld;
805 CHECK_STRING (dn); 801 CHECK_STRING (dn);
806 802
807 rc = ldap_delete_s (ld, NEW_LISP_STRING_TO_EXTERNAL (dn, Qnative)); 803 rc = ldap_delete_s (ld, LISP_STRING_TO_EXTERNAL (dn, Qnative));
808 if (rc != LDAP_SUCCESS) 804 if (rc != LDAP_SUCCESS)
809 signal_ldap_error (ld, NULL, rc); 805 signal_ldap_error (ld, NULL, rc);
810 806
811 return Qnil; 807 return Qnil;
812 } 808 }