File Coverage

blib/lib/Config/Apple/Profile/Payload/Common.pm
Criterion Covered Total %
statement 110 149 73.8
branch 29 68 42.6
condition 35 74 47.3
subroutine 25 27 92.5
pod 7 7 100.0
total 206 325 63.3


line stmt bran cond sub pod time code
1             # This is the code for Config::Apple::Profile::Payload::Common.
2             # For Copyright, please see the bottom of the file.
3              
4             package Config::Apple::Profile::Payload::Common;
5              
6 15     15   48875 use 5.10.1;
  15         39  
  15         515  
7 15     15   63 use strict;
  15         18  
  15         445  
8 15     15   55 use warnings FATAL => 'all';
  15         18  
  15         673  
9              
10             our $VERSION = '0.87';
11              
12 15     15   6355 use Data::GUID;
  15         192799  
  15         77  
13 15     15   9972 use Encode;
  15         111507  
  15         1092  
14 15     15   6815 use Mac::PropertyList;
  15         397729  
  15         905  
15 15     15   2467 use Readonly;
  15         11734  
  15         719  
16 15     15   71 use Scalar::Util;
  15         20  
  15         461  
17 15     15   7589 use Tie::Hash; # Also gives us Tie::StdHash
  15         10550  
  15         406  
18 15     15   6904 use Try::Tiny;
  15         15849  
  15         830  
19 15     15   6009 use version 0.77;
  15         21349  
  15         71  
20 15     15   7895 use Config::Apple::Profile::Payload::Tie::Root;
  15         44  
  15         530  
21 15     15   82 use Config::Apple::Profile::Payload::Types qw(:all);
  15         25  
  15         2252  
22 15     15   6265 use Config::Apple::Profile::Payload::Types::Serialize qw(serialize);
  15         30  
  15         833  
23 15     15   82 use Config::Apple::Profile::Payload::Types::Validation;
  15         21  
  15         519  
24 15     15   5056 use Config::Apple::Profile::Targets qw(:all);
  15         31  
  15         2135  
25              
26              
27             =encoding utf8
28              
29             =head1 NAME
30              
31             Config::Apple::Profile::Payload::Common - Base class for almost all payload
32             types, with common payload keys.
33              
34             =head1 DESCRIPTION
35              
36             This module serves two purposes.
37              
38             First, this module contains code to store payload data, to validate
39             client-provided data, and to export payload data as a plist.
40              
41             Second, this module defines the payload keys that are common to almost all
42             payload types. Specific payload types (classes) will include these common
43             payload types in their own payload type-specific list.
44              
45             Ideally, each payload type will be implemented as a class that subclasses this
46             one, using this class to do all of the work, leaving the subclass to
47             define the payload keys specific to that subclass.
48              
49             =head1 CLASS METHODS
50              
51             =head2 new()
52              
53             Returns a new object.
54              
55             =cut
56              
57             sub new {
58 240     240 1 202173 my ($self) = @_;
59 240   33     1096 my $class = ref($self) || $self;
60            
61             # The list of payload keys is defined in the class. Let's make it easy
62             # to reference for the instance.
63             ## no critic (ProhibitNoStrict)
64 15     15   84 no strict 'refs';
  15         18  
  15         708  
65             ## use critic
66 240         301 my $keys = \%{"${class}::payloadKeys"};
  240         892  
67 15     15   129 use strict 'refs';
  15         19  
  15         19351  
68            
69             # We're going to leverage Perl's hash-handling code to make payload keys
70             # easy for the Perl programmer to access.
71 240         308 my %payload;
72            
73             # Prepare out object
74 240         836 my $object = bless {
75             'keys' => $keys,
76             'payload' => \%payload,
77             }, $class;
78            
79             # Now that have the object, we can tie up the hash. YES, this will create
80             # a circular reference, which TIEHASH will deal with.
81 240         1235 tie %payload, 'Config::Apple::Profile::Payload::Tie::Root', $object;
82            
83             # Return the prepared object!
84 240         549 return $object;
85             }
86              
87              
88             =head1 INSTANCE METHODS
89              
90             =head2 keys()
91              
92             Returns a hashref that contains the list of payload keys recognized by this
93             instance.
94              
95             B The hashref points to a hash that is read-only. Any attempts to
96             modify will cause your code to die. You probably want to look at C.
97              
98             =cut
99              
100             sub keys {
101 3679     3679 1 11556 my ($self) = @_;
102 3679         13118 return $self->{keys};
103             }
104              
105              
106             =head2 payload()
107              
108             Returns a hashref that can be used to access the contents of the payload. This
109             is a reference to a tied hash, so you can not use it as liberally as a normal
110             hash. The only keys that will be accepted are those listed under
111             L.
112              
113             The following exception may be thrown when accessing a hash key:
114              
115             =over 4
116              
117             =item Config::Apple::Profile::Payload::Common::KeyInvalid
118              
119             Thrown when attempting to access a payload key that is not valid for this
120             payload.
121              
122             =back
123              
124             If a payload key is valid, but has not been set, then C is returned.
125              
126             The following exceptions may be thrown when setting a hash key:
127              
128             =over 4
129              
130             =item Config::Apple::Profile::Payload::Common::KeyInvalid
131              
132             Thrown when attempting to access a payload key that is not valid for this
133             payload.
134              
135             =item Config::Apple::Profile::Payload::Common::ValueInvalid
136              
137             Thrown when attempting to set an invalid value for this payload key.
138              
139             =back
140              
141             You can use C to test if a particular key is valid for this payload, and
142             you can use C to test if a particular key actually has a value defined.
143             Take note that calling C with an invalid key name will always return
144             false.
145              
146             You can use C to delete a key.
147              
148             =cut
149              
150             sub payload {
151 339     339 1 6961 my ($self) = @_;
152 339         1969 return $self->{payload};
153             }
154              
155              
156             =head2 plist([C => C, ...])
157              
158             Return a copy of this payload, represented as a L object.
159             All strings will be in UTF-8, and all Data entries will be Base64-encoded.
160             This method is used when assembling payloads into a profile.
161              
162             There are two ways to get string output from the plist object:
163              
164             # First, get your plist object from the payload
165             my $plist = $payload->plist();
166            
167             # If you just want the XML element and its contents, do this...
168             my $dict_element = $plist->write;
169            
170             # If you want the complete XML plist, with headers, do this...
171             use Mac::PropertyList;
172             my $complete_plist = Mac::PropertyList::plist_as_string($plist);
173              
174             Several parameters can be provided, which will influence how this method runs.
175              
176             =over 4
177              
178             =item target
179              
180             If C (a value from L) is provided,
181             then this will be taken into account when exporting. Only payload keys that
182             are used on the specified target will be included in the output.
183              
184             The C option controls what happens if keys are excluded.
185              
186             =item version
187              
188             If C (a version string) is provided, then only payload keys that work
189             on the specified version will be included in the output.
190              
191             If C is provided, then C must also be set, but C can
192             be set without setting C.
193              
194             The C option controls what happens if keys are excluded.
195              
196             =item completeness
197              
198             If C is set to a true value, and keys are excluded because of
199             C or C, then C will throw an exception. If set to a
200             false value, or if not set at all, then no exceptions will be thrown, and a
201             less-than-complete (but still valid) plist will be returned.
202              
203             =back
204              
205             The following exceptions may be thrown:
206              
207             =over 4
208              
209             =item Config::Apple::Profile::Exception::KeyRequired
210              
211             Thrown if a required key has not been set.
212              
213             =item Config::Apple::Profile::Exception::Incomplete
214              
215             Thrown if payload keys are being excluded from the output because of C
216             or C.
217              
218             =back
219              
220             =cut
221              
222             sub plist {
223 91     91 1 16083 my $self = $_[0];
224            
225             # Process parameters
226 91         112 my %params;
227 91         283 for (my $i = 1; $i < scalar(@_); $i += 2) {
228 0         0 my ($name, $value) = @_[$i,$i+1];
229            
230             # We have three parameters possible. Process each one
231 0 0       0 if ($name eq 'target') {
    0          
    0          
232 0 0 0     0 unless ( ($value == $TargetIOS)
233             || ($value == $TargetMACOSX)
234             ) {
235 0         0 die "Invalid target $value";
236             }
237 0         0 $params{target} = $value;
238             }
239            
240             elsif ($name eq 'version') {
241             try {
242 0     0   0 $params{version} = version->parse($value);
243             }
244             catch {
245 0     0   0 die "Failed to parse version $value";
246             }
247 0         0 }
248            
249             elsif ($name eq 'completeness') {
250 0 0       0 $params{completeness} = ($value ? 1 : 0);
251             }
252             } # Done inputting parameters
253            
254             # Catch someone setting version without setting target
255 91 50 33     248 if ( (exists $params{version})
256             && (!exists $params{target})
257             ) {
258 0         0 die "Version has been set, but no target was provided";
259             }
260            
261             # We're done with parameter processing and validation; do some work!
262            
263             # Prepare a hash that will be turned into the dictionary
264 91         95 my %dict;
265            
266             # Go through each key that could exist, and skip the ones that are undef.
267 91         295 Readonly my $keys => $self->keys();
268 91         8084 Readonly my $payload => $self->payload();
269 91         6755 foreach my $key (CORE::keys(%$keys)) {
270             # If the key isn't set, then skip it
271 211 100       1617 next unless defined($payload->{$key});
272            
273             # If target has been set, check it against the key's target
274 208 50       483 if (exists $params{target}) {
275 0 0       0 if (!exists($keys->{$key}->{targets}->{$params{target}})) {
276             # This key isn't used on this target, should we die?
277 0 0 0     0 if ( (exists($params{completeness}))
278             && ($params{completeness})
279             ) {
280 0         0 die "Key $key has been set, but isn't supported on this target";
281             }
282            
283             # If we're here, this key isn't used on this target, but we
284             # shouldn't die, so just skip the key.
285 0         0 next;
286             }
287            
288             # If we're here, this key is used on this target; check the version!
289 0         0 my $key_version = $keys->{$key}->{targets}->{$params{target}};
290 0 0 0     0 if ( (exists($params{version}))
291             && ($params{version} < version->parse($key_version))
292             ) {
293             # This key is too new for us, should we die?
294 0 0 0     0 if ( (exists($params{completeness}))
295             && ($params{completeness})
296             ) {
297 0         0 die "Key $key is only supported in newer OS versions";
298             }
299            
300             # If we're here, this key is too new for us, but we shouldn't
301             # die, so just skip the key.
302 0         0 next;
303             }
304            
305             # If we're here, then the version isn't set, or we're new enough!
306             } # Done checking target & version
307            
308             # Serialize the payload contents as a plist fragment, and store
309 208   100     416 $dict{$key} = serialize($keys->{$key}->{type},
310             $payload->{$key},
311             $keys->{$key}->{subtype} || undef
312             );
313             } # Done going through each payload key
314            
315             # Now that we have a populated $dict, make our final plist object!
316 91         361 my $plist = Mac::PropertyList::dict->new(\%dict);
317 91         1403 return $plist;
318             }
319              
320              
321             =head2 populate_id()
322              
323             Populates the C and C fields, if they are not
324             already set. In addition, if the payload has any keys of type
325             C<$PayloadClass>, then C will also be called on them.
326              
327             Sub-classes may decide to override this, so as to add extra functionality.
328              
329             =cut
330              
331             sub populate_id {
332 2     2 1 55 my ($self) = @_;
333            
334 2         5 my $keys = $self->keys;
335 2         5 my $payload = $self->payload;
336            
337             # Go through each key, and check the type
338 2         6 foreach my $key (CORE::keys %$keys) {
339 10         162 my $type = $keys->{$key}->{type};
340            
341             # We can call this method on other classes
342 10 50 33     105 if ( ($type !~ m/^\d+$/)
    100 0        
    100 33        
    50 0        
    50 33        
343             || ($type == $ProfileClass)
344             ) {
345             # Only populate IDs on objects that exist
346 0 0       0 if (defined $payload->{$key}) {
347 0         0 my $object = $payload->{$key};
348 0         0 $object->populate_id();
349             }
350             }
351              
352             # We can fill in UUIDs
353             elsif ($type == $ProfileUUID) {
354 2 100       18 if (!defined $payload->{$key}) {
355             # Make a new (random) GUID
356 1         5 $payload->{$key} = new Data::GUID;
357             }
358             }
359            
360             # We can fill in identifiers
361             elsif ($type == $ProfileIdentifier) {
362 2 100       24 if (!defined $payload->{$key}) {
363             # Just make some simple random identifier
364 1         89 $payload->{$key} = 'payload' . int(rand(2**30));
365             }
366             }
367            
368             # If we have an array of objects, we can do them, too!
369             elsif ( ($type == $ProfileArray)
370             && ( $keys->{$key}->{subtype} !~ m/^\d+$/
371             || $keys->{$key}->{subtype} == $ProfileClass
372             )
373             ) {
374 0         0 foreach my $item (@{$payload->{$key}}) {
  0         0  
375 0         0 $item->populate_id();
376             }
377             }
378            
379             # If we have an dictionary of objects, we can do them, also!
380             elsif ( ($type == $ProfileDict)
381             && ( $keys->{$key}->{subtype} !~ m/^\d+$/
382             || $keys->{$key}->{subtype} == $ProfileClass
383             )
384             ) {
385 0         0 foreach my $item (CORE::keys %{$payload->{$key}}) {
  0         0  
386 0         0 $payload->{$key}->{$item}->populate_id();
387             }
388             }
389            
390             # That's it! Move on to the next key
391             }
392             }
393              
394              
395             =head2 exportable([C])
396              
397             Returns true if the payload is complete enough to be exported. In other words,
398             all required keys must have values provided.
399              
400             C will return false if all UUID and Identifier fields are not
401             filled in, so it is suggested that you call C before calling
402             C.
403              
404             =cut
405              
406             sub exportable {
407 7     7 1 2796 my ($self, $target) = @_;
408            
409 7         12 my $keys = $self->keys;
410 7         10 my $payload = $self->payload;
411            
412             # Let's look for all keys that are required
413 7         19 foreach my $key (CORE::keys %$keys) {
414 21 100       211 next if exists $keys->{$key}->{optional};
415            
416 10         86 my $type = $keys->{$key}->{type};
417            
418             # If the key is a class and has been set, call ->exportable() on it.
419             # If the call returns 0, then we are not exportable.
420 10 0 33     76 return 0 if ( ($type == $ProfileClass)
      33        
421             && (defined $payload->{$key})
422             && ($payload->{$key}->exportable() == 0)
423             );
424            
425             # Special handling is needed for a required array
426 10 100       54 if ($type == $ProfileArray) {
427 2 100       8 return 0 if scalar(@{$payload->{$key}}) == 0;
  2         6  
428            
429             # If we have an array of classes, make sure each entry is exportable
430 1 50       4 if ($keys->{$key}->{subtype} == $ProfileClass) {
431 0         0 foreach my $entry (@{$payload->{$key}}) {
  0         0  
432 0 0       0 return 0 if ($entry->exportable == 0);
433             }
434             }
435             }
436            
437             # Special handling is needed for a required dictionary
438 9 50       49 if ($type == $ProfileDict) {
439 0 0       0 return 0 if scalar(CORE::keys %{$payload->{$key}}) == 0;
  0         0  
440            
441             # If we have a dict of classes, make sure each entry is exportable
442 0 0       0 if ($keys->{$key}->{subtype} == $ProfileClass) {
443 0         0 foreach my $entry (CORE::keys %{$payload->{$key}}) {
  0         0  
444 0 0       0 return 0 if ($entry->exportable == 0);
445             }
446             }
447             }
448            
449             # For every other key, return 0 if we are required but not set
450 9 100       74 return 0 unless defined $payload->{$key};
451            
452             # At this point, the key is required, and is defined, so we're good!
453             } # Done checking this key
454            
455             # If we've checked all the keys, and they're OK, then we're good!
456 3         16 return 1;
457             }
458              
459              
460             =head2 validate_key($key, $value)
461              
462             Confirm the value provided is valid for the given payload key, and return a
463             de-tained copy of C<$value>, or C if the provided value is invalid.
464              
465             C<$key> is the name of the payload key being set, and C<$value> is the proposed
466             new value. This class will perform checking for all payload types except for
467             Data payloads. The checks performed will be very basic.
468              
469             Subclasses should override this method to check their keys, and then call
470             SUPER::validate_key($self, $key, $value) to check the remaining keys.
471              
472             The following exceptions may be thrown:
473              
474             =over 4
475              
476             =item Config::Apple::Profile::Payload::Common::KeyUnknown
477              
478             Thrown if the payload key referenced is unknown.
479              
480             =back
481              
482             B An exception will B be thrown if the value is found to be
483             invalid. This is intentional!
484              
485             B To test the result of this method, you should use C,
486             because it's possible for a valid value to be false (for example, 0)!
487              
488             =cut
489              
490             sub validate_key {
491 681     681 1 936 my ($self, $key, $value) = @_;
492            
493             # Does our payload key exist?
494 681 50       1635 if (!exists $self->keys()->{$key}) {
495 0         0 die "Payload key $key is unknown";
496             }
497            
498             # At this point, we would have checks for specific payload keys,
499             # but our common keys don't need any special checking.
500            
501             # Get our payload key's value type
502 681         4462 my $type = $self->keys()->{$key}->{type};
503            
504             # If the payload key is an Array or a Dict, then we're actually checking
505             # the subtype of the key, not the type.
506 681 100 100     6040 if ( ($type == $ProfileArray)
507             || ($type == $ProfileDict)
508             ) {
509 380         2160 $type = $self->keys()->{$key}->{subtype};
510             }
511            
512             # If we are working with a basic type, then call the basic validator!
513 681 50 100     6211 if ( ($type == $ProfileString)
      100        
      66        
      100        
      100        
      66        
      66        
      33        
      66        
      66        
514             || ($type == $ProfileNumber)
515             || ($type == $ProfileReal)
516             || ($type == $ProfileBool)
517             || ($type == $ProfileData)
518             || ($type == $ProfileDate)
519             || ($type == $ProfileNSDataBlob)
520             || ($type == $ProfileDict)
521             || ($type == $ProfileArray)
522             || ($type == $ProfileIdentifier)
523             || ($type == $ProfileUUID)
524             ) {
525 681         21109 return Config::Apple::Profile::Payload::Types::Validation::validate($type, $value);
526             }
527            
528             # If we're still here, then something's wrong, so fail.
529             ## no critic (ProhibitExplicitReturnUndef)
530 0           return undef;
531             ## use critic
532             }
533              
534              
535             =head1 PAYLOAD KEYS
536              
537             Every payload type has a certain number of common keys. Those common keys are
538             defined (not stored) in C<%payloadKeys>.
539              
540             For general information on payload types, see
541             L.
542              
543             =head2 C
544              
545             A C for this specific payload. It must be unique.
546              
547             =head2 C
548              
549             A C for this specific payload. It must be unique.
550              
551             =head2 C
552              
553             I
554              
555             A C that the user will be able to see when looking at the details of the
556             profile that is about to be installed.
557              
558             =head2 C
559              
560             I
561              
562             A C that the user will be able to see when looking at the details of the
563             profile that is about to be installed.
564              
565             =head2 C
566              
567             I
568              
569             A C that the user will be able to see when looking at the details of the
570             profile that is about to be installed.
571              
572             =head2 C
573              
574             A C that identifies which type of payload this is. This value may
575             not be set by the client. Instead, the value is automatically determined based
576             on which C class is being used.
577              
578             =head2 C
579              
580             A C that identifies the version of the payload type. This specifies the
581             version of the standard, not the client's own revision number. Right now, all
582             payload types have a version number of C<1>.
583              
584             =cut
585              
586             Readonly our %payloadKeys => (
587             'PayloadIdentifier' => {
588             type => $ProfileIdentifier,
589             description => ('A Java-style reversed-domain-name identifier for'
590             . 'this payload.'),
591             targets => {
592             $TargetIOS => '5.0',
593             $TargetMACOSX => '10.7',
594             },
595             unique => 1,
596             },
597             'PayloadUUID' => {
598             type => $ProfileUUID,
599             description => 'A GUID for this payload.',
600             targets => {
601             $TargetIOS => '5.0',
602             $TargetMACOSX => '10.7',
603             },
604             unique => 1,
605             },
606             'PayloadDisplayName' => {
607             type => $ProfileString,
608             description => ('A short string that the user will see when '
609             . 'installing the profile.'),
610             targets => {
611             $TargetIOS => '5.0',
612             $TargetMACOSX => '10.7',
613             },
614             optional => 1,
615             },
616             'PayloadDescription' => {
617             type => $ProfileString,
618             description => "A longer description of the payload's purpose.",
619             targets => {
620             $TargetIOS => '5.0',
621             $TargetMACOSX => '10.7',
622             },
623             optional => 1,
624             },
625             'PayloadOrganization' => {
626             type => $ProfileString,
627             description => "The name of the payload's creator.",
628             targets => {
629             $TargetIOS => '5.0',
630             $TargetMACOSX => '10.7',
631             },
632             optional => 1,
633             },
634             ); # End of %payloadKeys
635              
636              
637             =head1 DEVELOPER NOTES
638              
639             The following sections have information that will be useful to people working
640             on the code that makes up this release.
641              
642             =head2 C<%payloadKeys> contents
643              
644             The C<%payloadKeys> hash is critical, so it is important to know how it is
645             constructed. To start, each key in the hash is a key that appears in a payload.
646             The value corresponding to the key is a hashref, which can contain the following
647             keys:
648              
649             =over 4
650              
651             =item C
652              
653             This key's value is a value from L.
654             It is used to specify the type of data the profile key contains.
655              
656             The type is used when creating L objects, and when doing
657             value-checking.
658              
659             If a payload class uses <$ProfileClass> as a type, then the payload class is
660             responsible for providing an instance method named C, which takes
661             the payload key name as its only parameter, and returns a new object.
662              
663             This key must be present.
664              
665             =item C
666              
667             This key is required when C is set to C<$ProfileDict> or C<$ProfileArray>.
668              
669             If C is set to C<$ProfileDict>, then C contains the type of
670             data stored as values. That data type will be used for validation, when
671             entries are added to the Perl hash representing the dictionary.
672              
673             If C is set to C<$ProfileArray>, then C contains the type of
674             data stored in the array. That data type will be used for validation, when
675             entries are added to the Perl array.
676              
677             If a payload class uses <$ProfileClass> as a subtype, then the payload class is
678             responsible for providing an instance method named C, which takes
679             the payload key name as its only parameter, and returns a new object.
680              
681             For other values of the C key, this key must I be present.
682              
683             =item C
684              
685             This key's value contains a human-readable description of the profile key. The
686             purpose of this is so that client software can easily enumerate profile keys,
687             such as when making a web application.
688              
689             This key must be present.
690              
691             =item C
692              
693             This key's value is a hashref. Within the hashref, the keys are platform
694             identifiers, scalars taken from C. The value
695             for each key is a version object representing the earliest version of the
696             named platform's OS which supports this payload key.
697              
698             If a platform does not support a particular key at all, that platform should not
699             be included in the hashref.
700              
701             This key must be present, and the hashref must contain at least one entry.
702              
703             =item C
704              
705             If this key is present, then this payload key does not have to be present.
706             This might mean that a key is completely optional (like C),
707             or it might mean that the value will be auto-generated (like C).
708              
709             It doesn't matter what this key is set to, its presence is what's important.
710              
711             Optional checks are done when L is run, at the very least.
712              
713             =item C
714              
715             If this key is present, then this payload key's value needs to be unique across
716             all payloads in the profile. This is normally used for things like the UUID and
717             the payload identifier, which need to be unique.
718              
719             It doesn't matter what this key is set to, its presence is what's important.
720              
721             Uniqueness checks are done during profile creation time only.
722              
723             =item C
724              
725             If this key is present, then this payload key's value is something that should
726             only be transmitted when the profile is encrypted. This is meant for things
727             like passwords, which should not be sent in the clear.
728              
729             Right now, none of the code in this release does anything with this key. It is
730             provided solely for future use.
731              
732             =item C
733              
734             If this key is present, then the corresponding value will be used as the value
735             for the payload key. Any attempts by the user to change the payload key's value
736             will throw an exception.
737              
738             This is used for things like PayloadVersion and PayloadType, which are fixed.
739              
740             =back
741              
742             =head1 ACKNOWLEDGEMENTS
743              
744             Refer to the L for acknowledgements.
745              
746             =head1 AUTHOR
747              
748             A. Karl Kornel, C<< >>
749              
750             =head1 COPYRIGHT AND LICENSE
751              
752             Copyright © 2014 A. Karl Kornel.
753              
754             This program is free software; you can redistribute it and/or modify it
755             under the terms of either: the GNU General Public License as published
756             by the Free Software Foundation; or the Artistic License.
757              
758             See L for more information.
759              
760             =cut
761              
762             1;