Uploader.pm 10.5 KB
Newer Older
Yadd's avatar
Yadd committed
1
2
3
4
5
## @file
# Test uploaded parameters and store new configuration

## @class
# Test uploaded parameters and store new configuration
Yadd's avatar
Yadd committed
6
7
8
9
10
11
12
13
14
package Lemonldap::NG::Manager::Uploader;

use strict;
use XML::LibXML;
use XML::LibXSLT;
use MIME::Base64;

# TODO
use Data::Dumper;
Yadd's avatar
Yadd committed
15
16
use Lemonldap::NG::Common::Safelib;        #link protected safe Safe object
use Lemonldap::NG::Manager::Downloader;    #inherits
Yadd's avatar
Yadd committed
17
18
19
use Lemonldap::NG::Manager::_Struct;       #link protected struct _Struct object
use Lemonldap::NG::Manager::_i18n;
use Lemonldap::NG::Common::Conf::Constants;    #inherits
Yadd's avatar
Yadd committed
20
21
22
23

our $VERSION = '0.1';
our ( $stylesheet, $parser );

Yadd's avatar
Yadd committed
24
25
26
27
## @method void confUpload(ref rdata)
# Parse rdata to find parameters using XSLT, test them and tries to store the
# new configuration
# @param $rdata pointer to posted datas
Yadd's avatar
Yadd committed
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
sub confUpload {
    my ( $self, $rdata ) = @_;
    $$rdata =~ s/<img.*?>//g;
    $$rdata =~ s/<li class="line".*?<\/li>//g;

    # Apply XSLT stylesheet to returned datas
    my $result =
      $self->stylesheet->transform(
        $self->parser->parse_string( '<root>' . $$rdata . '</root>' ) )
      ->documentElement();

    # Get configuration number
    unless ( $self->{cfgNum} =
        $result->getChildrenByTagName('conf')->[0]->getAttribute('value') )
    {
        die "No configuration number found";
    }
    my $newConf = { cfgNum => $self->{cfgNum} };

    # Loading returned parameters
48
    my $errors = {};
Yadd's avatar
Yadd committed
49
50
51
52
53
54
55
56
57
58
    foreach ( @{ $result->getChildrenByTagName('element') } ) {
        my ( $id, $name, $value ) = (
            $_->getAttribute('id'),
            $_->getAttribute('name'),
            $_->getAttribute('value')
        );
        my $NK = 0;
        $id =~
          s/^text_(NewID_)?li_(\w+)(\d)(?:_\d+)?$/decode_base64($2.'='x $3)/e;
        $NK = 1 if ($1);
Yadd's avatar
Yadd committed
59
        $id =~ s/\r//g;
Yadd's avatar
Yadd committed
60
61
62
63
64
65
66
        $id =~ s/^\///;
        $id =~ s/(?:\/[^\/]*)?$/\/$name/ if ($NK);
        next if ( $id =~ /^(generalParameters|virtualHosts)/ );
        my ( $confKey, $test ) = $self->getConfTests($id);
        my ( $res, $m );

        if ( !defined($test) ) {
67
            $errors->{errors}->{$name} =
Yadd's avatar
Yadd committed
68
69
70
71
72
73
74
75
76
77
78
79
80
81
              "Key $name: Lemonldap::NG::Manager error, see Apache's logs";
            $self->lmLog(
                "Unknown configuration key $id (name: $name, value: $value)",
                'error' );
            next;
        }

        if ( $test->{'*'} and $id =~ /\// ) { $test = $test->{'*'} }

        # Tests (no test for hash root nodes)
        unless ( $test->{keyTest} and ( $id !~ /\// or $test->{'*'} ) ) {
            if ( $test->{keyTest} ) {
                ( $res, $m ) = $self->applyTest( $test->{keyTest}, $name );
                unless ($res) {
82
                    $errors->{errors}->{$name} = $m || $test->{keyMsgFail};
Yadd's avatar
Yadd committed
83
84
85
86
87
88
                    next;
                }
            }
            if ( $test->{test} ) {
                ( $res, $m ) = $self->applyTest( $test->{test}, $value );
                unless ($res) {
89
                    $errors->{errors}->{$name} = $m || $test->{msgFail};
Yadd's avatar
Yadd committed
90
91
92
93
94
95
                    next;
                }
            }
            if ( $test->{warnKeyTest} ) {
                ( $res, $m ) = $self->applyTest( $test->{warnKeyTest}, $name );
                unless ($res) {
96
                    $errors->{warnings}->{$name} = $m || $test->{keyMsgWarn};
Yadd's avatar
Yadd committed
97
98
99
100
101
                }
            }
            if ( $test->{warnTest} ) {
                ( $res, $m ) = $self->applyTest( $test->{warnTest}, $value );
                unless ($res) {
102
                    $errors->{warnings}->{$name} = $m || $test->{keyMsgWarn};
Yadd's avatar
Yadd committed
103
104
105
106
107
108
109
110
111
112
113
114
115
                }
            }
        }
        $self->setKeyToH( $newConf, $confKey,
            $test->{keyTest}
            ? ( ( $id !~ /\// or $test->{'*'} ) ? {} : ( $name => $value ) )
            : $value );
    }

    # Loading unchanged parameters (ajax nodes not open)
    foreach ( @{ $result->getChildrenByTagName('ignore') } ) {
        my $node = $_->getAttribute('value');
        $node =~ s/^.*node=(.*?)(?:&.*)?\}$/$1/;
Yadd's avatar
Yadd committed
116
        foreach my $k ( $self->findAllConfKeys( $self->corresp($node) ) ) {
Yadd's avatar
Yadd committed
117
118
119
120
121
122
            my $v = $self->keyToH( $k, $self->conf );
            $v = $self->keyToH( $k, $self->defaultConf ) unless ( defined $v );
            if ( defined $v ) {
                $self->setKeyToH( $newConf, $k, $v );
            }
            else {
123
                $self->lmLog( "No default value found for $k", 'info' );
Yadd's avatar
Yadd committed
124
125
126
127
            }
        }
    }

128
    #print STDERR Dumper( $newConf, $errors );
129
130
    if ( $errors->{errors} ) {
        $errors->{result}->{cfgNum} = 0;
Yadd's avatar
Yadd committed
131
        $errors->{result}->{msg}    = $self->translate('syntaxError');
132
133
    }
    else {
134
        $self->confObj->{force} = 1 if ( $self->param('force') );
135
        $errors->{result}->{cfgNum} = $self->confObj->saveConf($newConf);
136
        $errors->{result}->{other}  = '';
Yadd's avatar
Yadd committed
137
138
139
140
141
        $errors->{result}->{msg}    = (
              $errors->{result}->{cfgNum} > 0
            ? $self->translate('confSaved')
            : $self->translate(
                {
142
143
144
145
146
                    CONFIG_WAS_CHANGED, 'confWasChanged',
                    UNKNOWN_ERROR,      'unknownError',
                    DATABASE_LOCKED,    'databaseLocked',
                    UPLOAD_DENIED,      'uploadDenied',
                    SYNTAX_ERROR,       'syntaxError',
Yadd's avatar
Yadd committed
147
148
149
                }->{ $errors->{result}->{cfgNum} }
            )
        );
150
151
152
153
154
155
        if (   $errors->{result}->{cfgNum} == CONFIG_WAS_CHANGED
            or $errors->{result}->{cfgNum} == DATABASE_LOCKED )
        {
            $errors->{result}->{other} = '<a href="javascript:uploadConf(1)">'
              . $self->translate('clickHereToForce') . '</a>';
        }
156
    }
Yadd's avatar
Yadd committed
157
    my $buf = '{';
Yadd's avatar
Yadd committed
158
    my $i   = 0;
159
    while ( my ( $type, $h ) = each %$errors ) {
Yadd's avatar
Yadd committed
160
        $buf .= ',' if ($i);
Yadd's avatar
Yadd committed
161
        $buf .= "'$type':{";
162
163
164
165
166
167
168
169
        $buf .= join(
            ',',
            map {
                $h->{$_} =~ s/'/\\'/;
                $h->{$_} =~ s/\n/ /g;
                "'$_':'$h->{$_}'"
              } keys %$h
        );
Yadd's avatar
Yadd committed
170
171
172
173
        $buf .= '}';
        $i++;
    }
    $buf .= '}';
Yadd's avatar
Yadd committed
174
175
176
177
    print $self->header(
        -type           => 'application/json',
        -Content_Length => length($buf)
    ) . $buf;
Yadd's avatar
Yadd committed
178
179
180
    $self->quit();
}

Yadd's avatar
Yadd committed
181
182
183
184
185
186
187
188
## @method protected array applyTest(void* test,string value)
# Apply the test to the value and return the result and an optional message
# returned by the test if the sub ref.
# @param $test Ref to a regexp or a sub
# @param $value Value to test
# @return Array containing:
# - the test result
# - an optional message
Yadd's avatar
Yadd committed
189
190
191
192
193
194
195
196
197
198
199
200
sub applyTest {
    my ( $self, $test, $value ) = @_;
    my ( $res, $msg );
    if ( ref($test) eq 'CODE' ) {
        ( $res, $msg ) = &$test($value);
    }
    else {
        $res = ( $value =~ $test ? 1 : 0 );
    }
    return ( $res, $msg );
}

Yadd's avatar
Yadd committed
201
202
## @method protected array getConfTests(string id)
# Call Lemonldap::NG::Manager::_Struct::testStruct().
Yadd's avatar
Yadd committed
203
204
205
206
207
208
209
210
211
212
sub getConfTests {
    my ( $self, $id ) = @_;
    my ( $confKey, $tmp ) = ( $id =~ /^(.*?)(?:\/(.*))?$/ );
    my $h = $self->testStruct()->{$confKey};
    if ( $h and $h->{'*'} and my ( $k, $v ) = ( $tmp =~ /^(.*?)\/(.*)$/ ) ) {
        return ( "$confKey/$k", $h->{'*'} );
    }
    return ( $confKey, $h );
}

Yadd's avatar
Yadd committed
213
214
215
216
217
## @method protected array findAllConfKeys(hashref h)
# Parse a tree structure to find all nodes corresponding to a configuration
# value.
# @param $h Tree structure
# @return Array of configuration parameter names
Yadd's avatar
Yadd committed
218
219
220
sub findAllConfKeys {
    my ( $self, $h ) = @_;
    my @res = ();
221
222
223
224
225

    # expand _nodes
    if ( ref( $h->{_nodes} ) eq 'CODE' ) {
        $h->{_nodes} = $h->{_nodes}->($self);
    }
Yadd's avatar
Yadd committed
226
227
228
229
230
231
232
233
234
235
    foreach my $n ( @{ $h->{_nodes} } ) {
        $n =~ s/^.*?:(.*?)(?:\:.*)?$/$1/;
        if ( ref( $h->{$n} ) ) {
            push @res, $self->findAllConfKeys( $h->{$n} );
        }
        else {
            my $m = $h->{$n} || $n;
            push @res, ( $m =~ /^(?:.*?:)?(.*?)(?:\:.*)?$/ ? $1 : () );
        }
    }
Yadd's avatar
Yadd committed
236
    push @res, @{ $h->{_upload} } if ( $h->{_upload} );
Yadd's avatar
Yadd committed
237
238
239
    return @res;
}

Yadd's avatar
Yadd committed
240
241
242
243
244
245
246
## @method protected void setKeyToH(hashref h,string key,string k2,string value)
# Insert key=>$value in $h at the position declared with $key. If $k2 is set,
# insert key=>{$k2=>$value}. Note that $key is splited with "/". The last part
# is used as key.
# @param $h New Lemonldap::NG configuration
# @param $key String "/path/key"
# @param $k2 Optional subkey
Yadd's avatar
Yadd committed
247
248
sub setKeyToH {
    my $value = pop;
Yadd's avatar
Yadd committed
249
    return unless ( ref($value) or length($value) );
Yadd's avatar
Yadd committed
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
    my ( $self, $h, $key, $k2 ) = @_;
    my $tmp = $h;
    $key =~ s/^\///;
    while (1) {
        if ( $key =~ /\// ) {
            my $k = $`;
            $key = $';
            $tmp = $tmp->{$k} ||= {};
        }
        else {
            if ($k2) {
                $tmp->{$key} = {} unless ( ref( $tmp->{$key} ) );
                $tmp->{$key}->{$k2} = $value;
            }
            else {
                $tmp->{$key} = $value;
            }
            last;
        }
    }
}

Yadd's avatar
Yadd committed
272
273
## @method private XML::LibXML parser()
# @return XML::LibXML object (cached in global $parser variable)
Yadd's avatar
Yadd committed
274
275
276
277
278
279
sub parser {
    my $self = shift;
    return $parser if ($parser);
    $parser = XML::LibXML->new();
}

Yadd's avatar
Yadd committed
280
281
282
283
## @method private XML::LibXSLT stylesheet()
# Returns XML::LibXSLT parser (cached in global $stylesheet variable). Use
# datas stored at the end of this file to initialize the object.
# @return XML::LibXSLT object
Yadd's avatar
Yadd committed
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
sub stylesheet {
    my $self = shift;

    return $stylesheet if ($stylesheet);
    my $xslt = XML::LibXSLT->new();
    my $style_doc = $self->parser->parse_string( join( '', <DATA> ) );
    close DATA;
    $stylesheet = $xslt->parse_stylesheet($style_doc);
}

1;
__DATA__
<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet version="1.0"
                xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
 <xsl:output method="xml"
             encoding="UTF-8"/>
 <xsl:template match="/">
  <root>
  <xsl:apply-templates/>
  </root>
 </xsl:template>
 <xsl:template match="li">
  <xsl:choose>
   <xsl:when test="starts-with(.,'.')">
    <ignore><xsl:attribute name="value"><xsl:value-of select="."/></xsl:attribute></ignore>
   </xsl:when>
   <xsl:otherwise>
    <xsl:apply-templates/>
   </xsl:otherwise>
  </xsl:choose>
 </xsl:template>
 <xsl:template match="span">
  <xsl:choose>
   <xsl:when test="@id='text_li_cm9vdA2'">
    <conf><xsl:attribute name="value"><xsl:value-of select="@value"/></xsl:attribute></conf>
   </xsl:when>
   <xsl:otherwise>
    <element>
     <xsl:attribute name="name"><xsl:value-of select="@name"/></xsl:attribute>
     <xsl:attribute name="id"><xsl:value-of select="@id"/></xsl:attribute>
     <xsl:attribute name="value"><xsl:value-of select="@value"/></xsl:attribute>
    </element>
   </xsl:otherwise>
  </xsl:choose>
 </xsl:template>
</xsl:stylesheet>