[Sommaire] [Imprimer]

   1  #!/usr/bin/perl -w
   2  
   3  use strict;
   4  use MIME::Base64;
   5  use Text::Iconv;
   6  
   7   #**************************************************************************
   8   #               fix-ldap-charset-for-egw1.1.pl  -  description            *
   9   #                             -------------------                         *
  10   #    begin                : Mon 2005/08/08                                *
  11   #    copyright            : (C) 2005 by Carsten Wolff                     *
  12   #    email                : wolffc@egroupware.org                         *
  13   #                                                                         *
  14   #   This program is free software; you can redistribute it and/or modify  *
  15   #   it under the terms of the GNU General Public License as published by  *
  16   #   the Free Software Foundation; either version 2 of the License, or     *
  17   #   (at your option) any later version.                                   *
  18   #                                                                         *
  19   #                                                                         *
  20   #   This script is used to adapt the charset in an egw ldap addressbook   *
  21   #   to the egw code in Release 1.1 and newer.                             *
  22   #                                                                         *
  23   #                                                                         *
  24   #   The old egw code just called utf8_encode on every attribute before    *
  25   #   writing and utf8_decode after reading an ldap attribute. This was     *
  26   #   fine as long as egw was run in iso8859-1, because then, calling       *
  27   #   utf8_encode was a proper conversion.                                  *
  28   #   But since egw supported systemcharsets, this call led to strings      *
  29   #   being encoded _twice_ before they were sent to ldap and thus being    *
  30   #   encoded in some weired mix of 2 charsets.                             *
  31   #   This of course confuses other LDAP-clients, because they don't        *
  32   #   know about the actual charset of the data anymore.                    *
  33   #   The new egw code now correctly _converts_ from every charset to utf8  *
  34   #   before sending data to ldap and converts from utf8 to systemcharset   *
  35   #   on reading. This of course makes it necessary, to correct the charset *
  36   #   of existing entries in the ldap-branch used by egw-addressbook        *
  37   #   (i.e. really make them utf-8), before the new code is being used.     *
  38   #                                                                         *
  39   #   How to use this script:                                               *
  40   #   1. make a datadump of your ldap database (f.e. slapcat>data.ldif)     *
  41   #   2. configure this script below                                        *
  42   #   3. convert the dump (./fix-ldap-charset-for-egw1.1.pl data.ldif)      *
  43   #   4. reimport the dump (f.e. slapadd -l data.ldif.conv)                 *
  44   #                                                                         *
  45   #**************************************************************************
  46  
  47  ##############################################################################
  48  # CONFIGURATION - BEGIN
  49  #
  50  #
  51  # only entries below this DN will be converted
  52  my $basedn = "ou=addressbook,dc=domain,dc=xyz";
  53  # this is the systemcharset of eGW, that was used at the time
  54  # when the eGW-Code of your installation still was version 1.0.x or earlier
  55  my $egw_systemcharset = "utf-8";
  56  #
  57  #
  58  # CONFIGURATION - END
  59  ##############################################################################
  60  
  61  
  62  # parameters
  63  my $filename = $ARGV[0];
  64  unless (-f $filename) {
  65      print "usage: " . $0 . " {ldif-filename}\n";
  66      exit 0;
  67  }
  68  
  69  # global objects
  70  my $iconv_outer = Text::Iconv->new("utf-8", "iso-8859-1");
  71  my $iconv_inner = Text::Iconv->new($egw_systemcharset, "utf-8");
  72  
  73  # get an array of all entries
  74  local $/;  # slurp mode
  75  open(FOLD, "< $filename\0") || die "error opening source-file: $filename: $!";
  76  flock(FOLD, 2);
  77  my $file = <FOLD>;
  78  my @old = split("\n\n",$file);
  79  flock(FOLD, 8);
  80  close(FOLD);
  81  
  82  print "\nRead " . $#old . " entries from " . $filename . "\n";
  83  
  84  # begin with conversion
  85  my @new = ();
  86  my $i = 0;
  87  foreach my $oldentry (@old) {
  88      my $workentry = $oldentry;
  89      # concatenate base64 multline data
  90      $workentry =~ s/\n //g;
  91      # extract the raw DN and get it's readable form
  92      $workentry =~ /^(dn:[^\n]*)\n/;
  93      my %dn = getAttributeValue($1);
  94      # check, if this entry is to be converted
  95      my $basednregexp = regexpEscape($basedn);
  96      unless ($dn{'value'} =~ /^.+$basednregexp$/) {
  97          push(@new, $oldentry . "\n");
  98          next;
  99      }
 100      #
 101      # This entry is to be converted
 102      #
 103      my $newentry = "";
 104      my @attributes = split("\n", $workentry);
 105      foreach my $attr (@attributes) {
 106          my %attrib = getAttributeValue($attr);
 107          $attrib{'value'} = $iconv_inner->convert($iconv_outer->convert($attrib{'value'}));
 108          $newentry .= attrib2ldif(\%attrib);
 109      }
 110      push(@new,$newentry);
 111      $i++;
 112  }
 113  print "Converted $i entries in $basedn\n";
 114  
 115  # write the result
 116  open(FNEW, "> $filename" . ".conv\0") || die "error opening destination-file: $filename" . ".conv: $!";
 117  flock(FNEW, 2);
 118  foreach(@new) {
 119      print FNEW $_ . "\n";
 120  }
 121  flock(FNEW, 8);
 122  close(FNEW);
 123  
 124  print "Wrote $#new entries to $filename.conv\n\nPlease check the number of entries and have a look at\n$filename.conv, before reimporting it.\n\n";
 125  
 126  #####################
 127  # Subroutines
 128  #####################
 129  
 130  # break down an attribute in attribute-name and value
 131  # if the value is base64, decode it.
 132  sub getAttributeValue {
 133      my ($rawattr) = @_;
 134      my %attr = ();
 135      if ($rawattr =~ /^([^:]*):: (.*)/) {
 136          $attr{'name'} = $1;
 137          $attr{'value'} = decode_base64($2);
 138      } elsif ($rawattr =~ /^([^:]*): (.*)/) {
 139          $attr{'name'} = $1;
 140          $attr{'value'} = $2;
 141      } else {
 142          print "Error extracting data from attribute: " . $rawattr . "\n";
 143      }
 144      return %attr;
 145  }
 146  
 147  # escape a string for use within a regexp
 148  sub regexpEscape {
 149      my ($string) = @_;
 150      $string =~ s/([\^\.\$\|\(\)\[\]\*\+\?\{\}])/\\$1/g;
 151      return $string;
 152  }
 153  
 154  # cahnge an attribute in suitable form for an ldif
 155  sub attrib2ldif {
 156      my ($attrib) = @_;
 157      my ($key, $value) = ($attrib->{'name'}, $attrib->{'value'});
 158      # RFC2894 requires a string to be BASE64 encoded, if
 159      # - it begins with a char that's not a SAFE-INIT-CHAR
 160      # - or it contains a char that's not a SAFE-CHAR
 161      if ($value =~ /^[: <]/ or $value =~ /[^\x01-\x09\x0b-\x0c\x0e-\x7f]/) {
 162          # email-addresses can not contain unicode-characters
 163          if ($key eq "mail" or $key eq "phpgwMailHome") {
 164              print "Warning: forbidden characters in eMail-address detected: " . $value . "\n";
 165          }
 166          $value = encode_base64($value);
 167          $value =~ s/\n//g;
 168          # each line has to be no more than 77 characters long
 169          # including a leading space and, on the first line, the key.
 170          # Exceptions: dn and rdn
 171          unless ($key eq "dn" or $key eq "rdn") {
 172              my $keylen = length($key) + 3;
 173              my $form = substr($value, 0, 77 - $keylen);
 174              unless ($form eq $value) {
 175                  my $j = 0;
 176                  my $next = "";
 177                  do  {
 178                      $next = substr($value, 77 - $keylen + $j * 76, 76);
 179                      $form .= "\n " . $next;
 180                      $j++;
 181                  } until (length($next) < 76);
 182              }
 183              $value = $form;
 184          }
 185          $key = $key . ":: ";
 186      } else {
 187          $key = $key . ": ";
 188      }
 189      return $key . $value . "\n";
 190  }