Content Delivery Network (CDN) - optional, for either uploads only or both uploads & extras (rfe 9134)

etc/WebGUI.conf.original

@@ -991,5 +991,19 @@
     "WebGUI::Shop::TaxDriver::EU"
 ],
 
-}
+# Content Delivery Network - for use with WebGUI::Storage
+# required for CDN: enabled, url, queuePath, syncProgram, deleteProgram
+# optional for CDN: sslAlt, sslUrl, extrasCdn, extrasSsl, extrasExclude
+"cdn" : { "enabled" : 0,
+          "url" : "http://content.example.com",
+          "sslAlt" : 0,
+          "sslUrl" : "https://ssl.example.com",
+          "queuePath" : "/data/cdnqueue",
+          "syncProgram" : "/usr/bin/rsync -av --chmod=u+rwx -- '%s' user@content.example.com:/path",
+          "deleteProgram" : "/usr/bin/ssh user@content.example.com 'rm -Rf -- %s'"
+          "extrasCdn" : "http://content.example.com/extras",
+          "extrasSsl" : "https://content.example.com/extras",
+          "extrasExclude": ["tinymce", "^blah$"]
+        }
 
+}

lib/WebGUI/Session/Id.pm

@@ -42,6 +42,28 @@ These methods are available from this class:
 
 =cut
 
+
+#-------------------------------------------------------------------
+
+=head2 fromHex ( hexId )
+
+Returns the guid corresponding to hexId.  Converse of toHex.
+
+=head3 hexId
+
+Hex value to convert to guid.
+
+=cut
+
+sub fromHex {
+    my $self = shift;
+    my $hexId = shift;
+    my $binId = pack('H2' x 16, unpack('A2' x 16, $hexId));
+    my $id = substr(encode_base64($binId), 0, 22);
+    $id =~ tr{+/}{_-};
+    return $id;
+}
+
 #-------------------------------------------------------------------
 
 =head2 DESTROY ( )

lib/WebGUI/Session/Url.pm

@@ -131,7 +131,7 @@ sub escape {
 
 =head2 extras ( path )
 
-Combinds the base extrasURL defined in the config file with a specfied path.
+Combines the base extrasURL defined in the config file with a specified path.
 
 =head3 path
 
@@ -144,7 +144,20 @@ consecutive slashes in the path part of the URL will be replaced with a single s
 sub extras {
     my $self = shift;
     my $path = shift;
-    my $url = $self->session->config->get("extrasURL").'/'.$path;
+    my $url = $self->session->config->get("extrasURL");
+    my $cdnCfg = $self->session->config->get('cdn');
+    if ($cdnCfg  and  $cdnCfg->{'enabled'}  and  $cdnCfg->{'extrasCdn'}) {
+       unless ($path and grep $path =~ m/$_/, @{$cdnCfg->{'extrasExclude'}}) {
+          if ($cdnCfg->{'extrasSsl'}  and
+              ($self->session->env->get('HTTPS') eq 'on'  or
+               $self->session->env->get('SSLPROXY'))) {
+             $url = $cdnCfg->{'extrasSsl'};
+          } else {
+             $url = $cdnCfg->{'extrasCdn'};
+          }
+       }  # if excluded, stick with regular extrasURL
+    }
+    $url .= '/' . $path;
     $url =~ s$(?<!:)/{2,}$/$g;  ##Remove //, unless it's after a :, which can't be a valid URL character
     return $url;
 }

lib/WebGUI/Storage.pm

@@ -106,6 +106,75 @@ sub _addError {
 }
 
 
+#-------------------------------------------------------------------
+
+=head2 _cdnAdd ( )
+
+Adds to CDN queue, for any of the add* methods.
+
+NOTE: This is a private method and should never be called except internally to this package.
+
+=cut
+
+sub _cdnAdd {
+	my $self = shift;
+	my $cdnCfg = $self->session->config->get('cdn');
+ 	if ($cdnCfg  and  $cdnCfg->{'enabled'}) {
+	   if ($cdnCfg->{'queuePath'}) {
+		  my $cdnFile = $cdnCfg->{'queuePath'} . '/' . $self->session->id->toHex($self->getId);
+		  my $dest;
+		  if ( open $dest, '>', $cdnFile ) {
+			 close $dest;  # created empty file
+		  } else {
+			 $self->_addError("CDN: Couldn't open file $cdnFile for writing due to error: ".$!);
+		  }
+	   } else {
+		  $self->_addError('Invalid CDN configuration - missing queuePath');
+	   }
+	}
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 _cdnDel ( [delDotCdn] )
+
+Add file denoting deletion to the CDN queue, for the clear & delete methods.
+
+NOTE: This is a private method and should never be called except internally to this package.
+
+=head3 delDotCdn
+
+Delete the ".cdn" file - clear vs. delete.
+
+=cut
+
+sub _cdnDel {
+	my $self = shift;
+	my $delDotCdn = shift;
+	my $cdnCfg = $self->session->config->get('cdn');
+ 	if ($cdnCfg  and  $cdnCfg->{'enabled'}) {
+	   my $cdnFile;   # path/name of flag and/or queue file
+	   if ($delDotCdn) {
+		  $cdnFile = $self->getPath . '/.cdn';
+		  unlink $cdnFile;
+	   }
+	   if ($cdnCfg->{'queuePath'}) {
+		  $cdnFile = $cdnCfg->{'queuePath'} . '/' . $self->session->id->toHex($self->getId);
+		  my $dest;
+		  if ( open $dest, '>', $cdnFile ) {
+			 print $dest "deleted\n";
+			 close $dest;
+		  } else {
+			 $self->_addError("Couldn't open file $cdnFile for writing due to error: ".$!);
+		  }
+	   } else {
+		  $self->_addError('Invalid CDN configuration - missing queuePath');
+	   }
+	}
+}
+
+
 #-------------------------------------------------------------------
 
 =head2 _makePath ( )
@@ -158,6 +227,8 @@ sub _changeOwner {
 
 Generates a captcha image (200x x 50px) and returns the filename and challenge string (6 random characters). For more information about captcha, consult the Wikipedia here: http://en.wikipedia.org/wiki/Captcha
 
+Note: captcha images will NOT be synchronized to a CDN, even if other files are.
+
 =cut 
 
 sub addFileFromCaptcha {
@@ -212,6 +283,7 @@ sub addFileFromCaptcha {
 =head2 addFileFromFilesystem( pathToFile )
 
 Grabs a file from the server's file system and saves it to a storage location and returns a URL compliant filename.  If there are errors encountered during the add, then it will return undef instead.
+If configured for CDN, add this storage location to CDN queue.
 
 =head3 pathToFile
 
@@ -256,6 +328,7 @@ sub addFileFromFilesystem {
         or $self->_addError("Couldn't copy $pathToFile to ".$self->getPath($filename).": $!");
     close $dest;
     close $source;
+    $self->_cdnAdd;
     return $filename;
 }
 
@@ -265,6 +338,7 @@ sub addFileFromFilesystem {
 =head2 addFileFromFormPost ( formVariableName, attachmentLimit )
 
 Grabs an attachment from a form POST and saves it to this storage location.
+If configured for CDN, add this storage location to CDN queue.
 
 =head3 formVariableName
 
@@ -289,8 +363,10 @@ sub addFileFromFormPost {
     my $attachmentCount = 1;
     foreach my $upload ($session->request->upload($formVariableName)) {
         $session->errorHandler->info("Trying to get " . $upload->filename." from ".$formVariableName);
-        return $filename
+        if ($attachmentCount > $attachmentLimit) {
-            if $attachmentCount > $attachmentLimit;
+            $self->_cdnAdd;
+            return $filename;
+        }
         my $clientFilename = $upload->filename;
         next
             unless $clientFilename;
@@ -316,6 +392,7 @@ sub addFileFromFormPost {
             return undef;
         }
     }
+    $filename  and  $self->_cdnAdd;
     return $filename;
 }
 
@@ -325,6 +402,7 @@ sub addFileFromFormPost {
 =head2 addFileFromHashref ( filename, hashref )
 
 Stores a hash reference as a file and returns a URL compliant filename. Retrieve the data with getFileContentsAsHashref.
+If configured for CDN, add this storage location to CDN queue.
 
 =head3 filename
 
@@ -343,6 +421,7 @@ sub addFileFromHashref {
     Storable::nstore($hashref, $self->getPath($filename))
         or $self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
     $self->_changeOwner($self->getPath($filename));
+	$filename  and  $self->_cdnAdd;
 	return $filename;
 }
 
@@ -351,6 +430,7 @@ sub addFileFromHashref {
 =head2 addFileFromScalar ( filename, content )
 
 Adds a file to this storage location and returns a URL compliant filename.
+If configured for CDN, add this storage location to CDN queue.
 
 =head3 filename
 
@@ -373,6 +453,7 @@ sub addFileFromScalar {
 		print $FILE $content;
 		close($FILE);
         $self->_changeOwner($self->getPath($filename));
+        $self->_cdnAdd;
 	}
     else {
         $self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
@@ -415,6 +496,7 @@ sub adjustMaxImageSize {
 =head2 clear ( )
 
 Clears a storage locations of all files except the .wgaccess file
+If configured for CDN, add deletion of this location's files, to CDN queue.
 
 =cut
 
@@ -424,6 +506,7 @@ sub clear {
 	foreach my $file (@{$filelist}) {
        $self->deleteFile($file);
     }
+    $self->_cdnDel(1);
 }
 
 
@@ -431,7 +514,8 @@ sub clear {
 
 =head2 copy ( [ storage, filelist ] )
 
-Copies a storage location and it's contents. Returns a new storage location object. Note that this does not copy privileges or other special filesystem properties.
+Copies a storage location and its contents. Returns a new storage location object. Note that this does not copy privileges or other special filesystem properties.
+If configured for CDN, add the resulting new storage location to CDN queue.
 
 =head3 storage
 
@@ -448,6 +532,7 @@ sub copy {
     my $newStorage = shift || WebGUI::Storage->create($self->session);
     my $filelist = shift || $self->getFiles(1);
     foreach my $file (@{$filelist}) {
+        next if  $file eq '.cdn';
         open my $source, '<:raw', $self->getPath($file) or next;
         open my $dest, '>:raw', $newStorage->getPath($file) or next;
         File::Copy::copy($source, $dest) or $self->_addError("Couldn't copy file ".$self->getPath($file)." to ".$newStorage->getPath($file)." because ".$!);
@@ -455,6 +540,7 @@ sub copy {
         close $source;
         $newStorage->_changeOwner($newStorage->getPath($file));
     }
+    $newStorage->_cdnAdd;
     return $newStorage;
 }
 
@@ -464,6 +550,7 @@ sub copy {
 
 Copy a file in this storage location. C<filename> is the file to copy. 
 C<newFilename> is the new file to create.
+If configured for CDN, add this storage location to CDN queue.
 
 =cut
 
@@ -481,6 +568,7 @@ sub copyFile {
         || croak "Couldn't copy '$filename' to '$newFilename': $!";
     $self->_changeOwner($self->getPath($filename));
 
+    $self->_cdnAdd;
     return undef;
 }
 
@@ -539,6 +627,7 @@ sub createTemp {
 =head2 delete ( )
 
 Deletes this storage location and its contents (if any) from the filesystem.
+If configured for CDN, add deletion of this storage location to CDN queue.
 
 =cut
 
@@ -554,6 +643,8 @@ sub delete {
         # can only remove empty directories, will fail silently otherwise
         rmdir $fullPath;
     }
+    # Delete the content from the CDN - enqueue
+    $self->_cdnDel(0);
     $self->session->errorHandler->info("Deleted storage ".$self->getId);
     return undef;
 }
@@ -562,7 +653,7 @@ sub delete {
 
 =head2 deleteFile ( filename )
 
-Deletes a file from it's storage location.
+Deletes a file from its storage location.
 
 =head3 filename
 
@@ -581,6 +672,38 @@ sub deleteFile {
 }
 
 
+#-------------------------------------------------------------------
+
+=head2 deleteFromCdn ( )
+
+Run config/cdn/deleteProgram to synchronize this location to Content Delivery Network.
+Replace %s with the path of the storage location.
+Also delete the related file in config/cdn/queuePath.
+
+=cut
+
+sub deleteFromCdn {
+    my $self   = shift;
+    my $cdnCfg = $self->session->config->get('cdn');
+    if ($cdnCfg  and  $cdnCfg->{'enabled'}
+        and  $cdnCfg->{'syncProgram'}) {
+       my $id = $self->session->id->toHex($self->getId);
+       my $cmd = sprintf($cdnCfg->{'deleteProgram'}, $id);
+       if ($cmd =~ /$id/)  {  # sanity check, no rm -rf /
+          system($cmd);
+          if ($?) {   # This may occur benign in the case delete after clear
+             $self->_addError("Error running CDN deleteProgram: $?");
+          }
+          if ($cdnCfg->{'queuePath'}) {
+             unlink $cdnCfg->{'queuePath'} . '/' . $self->session->id->toHex($self->getId);
+          }
+       } else  {   # Presume configuration error, missing %s
+          $self->_addError("CDN deleteProgram: storage ID missing from command: $cmd");
+       }
+    }
+}
+
+
 #-------------------------------------------------------------------
 
 =head2 get ( session, id )
@@ -676,6 +799,46 @@ sub generateThumbnail {
 	return 1;
 }
 
+
+#-------------------------------------------------------------------
+
+=head2 getCdnFileIterator ( session )
+
+Class method to return an iterator method full of storage objects to
+be updated or deleted, based upon what's in config/cdn/queuePath.
+
+=head3 session
+
+A reference to the current session.
+
+=cut
+
+sub getCdnFileIterator {
+	my $class   = shift;
+	my $session = shift;
+	my $cdnCfg = $session->config->get('cdn');
+	if ($cdnCfg  and  $cdnCfg->{'enabled'}) {
+		if ($cdnCfg->{'queuePath'}) {
+			if (opendir my $DH, $cdnCfg->{'queuePath'}) {
+				my @ids = grep { !/^\.+$/ }
+				               readdir($DH);
+				close $DH;
+				my $sub = sub {
+					my $id = shift @ids;
+					return	if !$id;
+					return $class->get($session, $session->id->fromHex($id));
+				};
+				return $sub;
+			} else {
+				$session->errorHandler->warn("CDN: cannot read directory $cdnCfg->{'queuePath'}");
+			}
+		} else {
+			$session->errorHandler->warn("CDN: enabled but no queuePath");
+		}
+	}
+}
+
+
 #-------------------------------------------------------------------
 
 =head2 getSize ( filename ) 
@@ -702,6 +865,7 @@ sub getSize {
 	return($x, $y);
 }
 
+
 #-------------------------------------------------------------------
 
 =head2 getErrorCount ( )
@@ -1026,6 +1190,22 @@ sub getUrl {
 	my $url = $self->session->config->get("uploadsURL")
             . '/'
             . $self->getPathFrag;
+	my $cdnCfg = $self->session->config->get('cdn');
+	if ($cdnCfg  and  $cdnCfg->{'enabled'}  and  $cdnCfg->{'url'}
+		and  -e $self->getPath . '/.cdn') {
+	   my $sep = '/';   # separator, if not already present trailing
+	   if ($cdnCfg->{'sslAlt'}  and
+		   ($self->session->env->get('HTTPS') eq 'on'  or
+			$self->session->env->get('SSLPROXY'))) {
+		  if ($cdnCfg->{'sslUrl'}) {
+			 substr($cdnCfg->{'sslUrl'}, -1) eq '/'  and  $sep = '';
+			 $url = $cdnCfg->{'sslUrl'} . $sep . $self->session->id->toHex($self->getId);
+		  }  # else do NOT override $url with CDN URL  ($url = $sslUrl || $url)
+	   } else {
+		  substr($cdnCfg->{'url'}, -1) eq '/'  and  $sep = '';
+		  $url = $cdnCfg->{'url'} . $sep . $self->session->id->toHex($self->getId);
+	   }
+	}
 	if (defined $file) {
 		$url .= '/'.$file;
 	}
@@ -1408,6 +1588,43 @@ sub setPrivileges {
 }
 
 
+#-------------------------------------------------------------------
+
+=head2 syncToCdn ( )
+
+Run config/cdn/syncProgram to synchronize this location to Content Delivery Network.
+Replace %s with the path of the storage location.
+Also put an empty ".cdn" file in the storage location, and then delete
+the related file in config/cdn/queuePath.
+
+=cut
+
+sub syncToCdn {
+    my $self   = shift;
+    my $cdnCfg = $self->session->config->get('cdn');
+    if ($cdnCfg  and  $cdnCfg->{'enabled'}
+        and  $cdnCfg->{'syncProgram'}) {
+       my $originalDir = Cwd::cwd();
+       my $locDir = join '/', $self->session->config->get('uploadsPath'), @{$self->{_pathParts}}[0..1];
+       chdir $locDir  or croak 'Unable to chdir to ' . $locDir . " : $!";
+       my $cmd = sprintf($cdnCfg->{'syncProgram'}, $self->session->id->toHex($self->getId));
+       system($cmd);
+       if ($?) {
+          $self->_addError("Error running CDN syncProgram: $?");
+       } elsif ($cdnCfg->{'queuePath'}) {
+          unlink $cdnCfg->{'queuePath'} . '/' . $self->session->id->toHex($self->getId);
+       }
+       chdir $originalDir;
+       my $dest;
+       my $cdnFile = $self->getPath . '/.cdn';
+       if ( open $dest, '>', $cdnFile ) {
+          close $dest;  # created empty file
+       } else {
+          $self->_addError("Couldn't open file $cdnFile for writing due to error: ".$!);
+       }
+    }
+}
+
 
 #-------------------------------------------------------------------
 

sbin/syncToCdn.pl

@@ -0,0 +1,206 @@
+#-------------------------------------------------------------------
+# WebGUI is Copyright 2001-2009 Plain Black Corporation.
+#-------------------------------------------------------------------
+# Please read the legal notices (docs/legal.txt) and the license
+# (docs/license.txt) that came with this distribution before using
+# this software.
+#-------------------------------------------------------------------
+# http://www.plainblack.com                     info@plainblack.com
+#-------------------------------------------------------------------
+
+our $webguiRoot;
+
+BEGIN { 
+	$webguiRoot = "..";
+	unshift (@INC, $webguiRoot."/lib"); 
+}
+
+use strict;
+use Fcntl ':flock';
+use Getopt::Long;
+use WebGUI::Session;
+use WebGUI::Storage;
+
+my $configFile;
+my $help;
+my $migrate;
+my $override;
+my $quiet;
+
+GetOptions(
+	'configFile=s'     => \$configFile,
+	'override'         => \$override,
+	'migrate'          => \$migrate,
+	'quiet'            => \$quiet,
+);
+
+
+if ($configFile eq "") {
+	printHelp();
+	exit 4;
+};
+
+if ($help) {
+	printHelp();
+	exit 2;
+}
+
+# don't want two copies of this to run simultaneously
+unless (flock(DATA, LOCK_EX|LOCK_NB)) {
+    print "$0 is already running. Exiting.\n";
+    exit 3;
+}
+
+sub printHelp {
+	print <<STOP;
+
+Usage: perl $0 --configfile=<webguiConfig>
+
+	--configFile		WebGUI config file.
+
+Options:
+
+	--override		This utility is designed to be run as
+				a privileged user on Linux style systems.
+				If you wish to run this utility without
+				being the super user, then use this flag,
+				but note that it may not work as
+				intended.
+
+	--migrate		Migrate entirety of uploads directory to CDN.
+				Ignore the CDN queue and sync everything.
+
+	--help			Display this help message and exit.
+
+	--quiet			Disable output unless there's an error.
+
+EXIT STATUS
+
+  The following exit values are returned:
+
+  0
+	Successful execution.
+
+  1
+	Only super user may run the script.
+
+  2
+	Help requested.
+
+  3
+	Only one instance of this script can run at a time.
+
+  4
+	Error during invocation of the command.
+
+  5
+	Content Delivery Network (CDN) is not enabled.
+
+STOP
+}
+
+if (!($^O =~ /^Win/i) && $> != 0 && !$override) {
+	print "You must be the super user to use this utility.\n";
+	exit 1;
+}
+
+print "Starting..." unless ($quiet);
+my $session = WebGUI::Session->open($webguiRoot,$configFile);
+$session->user({userId=>3});
+print "OK\n" unless ($quiet);
+
+my $cdnCfg = $session->config->get('cdn');
+unless ($cdnCfg  and  $cdnCfg->{'enabled'}  and  $cdnCfg->{'queuePath'}) {
+   print "Content delivery network (CDN) is not enabled in $configFile.\n";
+   exit 5;
+}
+
+# Here is the core of the script
+if ($migrate)  {
+   syncUploads($session);
+} else {
+   syncQueue($session, $cdnCfg);
+}
+
+print "Cleaning up..." unless ($quiet);
+$session->var->end();
+$session->close();
+
+print "OK\n" unless ($quiet);
+exit 0;
+
+
+#-----------------------------------------
+# syncQueue(session, cdnConfig)
+#-----------------------------------------
+
+sub syncQueue  {
+    my $session = shift;
+    my $cdnCfg = shift;
+    my $locIter = WebGUI::Storage->getCdnFileIterator($session);
+    while (my $store = $locIter->()) {
+       my $ctrlFile = $cdnCfg->{'queuePath'} . '/' . $session->id->toHex($store->getId);
+       if (-r $ctrlFile  and  -s $ctrlFile < 12) {
+          if (! -s $ctrlFile)  {   # Empty means sync/add/update
+             $store->syncToCdn;
+          } else {   # expect "deleted" but be careful.
+             if (open my $ctrlFH, "<$ctrlFile") {
+                my $directive = <$ctrlFH>;
+                chomp $directive;
+                close $ctrlFH;
+                if ($directive =~ m/^deleted$/i) {
+                   $store->deleteFromCdn;
+                }  # else unknown - ignore
+             } else {
+                warn "Cannot read CDN control file $ctrlFile.";
+                $session->errorHandler->warn("Cannot read CDN control file $ctrlFile.");
+             }
+          }
+       } else {   # missing or invalid
+          print "No recognizable CDN control file $ctrlFile.\n";
+       }
+    }
+}  # end syncQueue
+
+
+#-----------------------------------------
+# syncUploads(session)
+#-----------------------------------------
+
+sub syncUploads  {
+    my $session = shift;
+    # Alternate approach would be touch queue files, then run queue.
+    my $uDir = $session->config->get('uploadsPath');
+    if (opendir my $DH, $uDir) {
+       my @part1 = grep { !/^\.+$/ } readdir($DH);
+       foreach my $subdir (@part1) {
+          if (opendir my $SD, "$uDir/$subdir") {
+             my @part2 = grep { !/^\.+$/ } readdir($SD);
+             foreach my $sub2 (@part2) {
+                if (opendir my $S2, "$uDir/$subdir/$sub2") {
+                   my @fileId = grep { !/^\.+$/ } readdir($S2);
+                   foreach my $fileId (@fileId) {
+                      my $store = WebGUI::Storage->get($session,
+                                                       $session->id->fromHex($fileId));
+                      $store->syncToCdn;  # here is the meat
+                   }
+                   close $S2;
+                } else {
+                   $session->errorHandler->warn("Unable to open $sub2 for directory reading");
+                }
+             }
+             close $SD;
+          } else {
+             $session->errorHandler->warn("Unable to open $subdir for directory reading");
+          }
+       }
+       close $DH;
+    } else {
+       $session->errorHandler->warn("Unable to open $uDir for directory reading");
+    }
+}  # end syncUploads
+
+
+__DATA__
+This exists so flock() code above works.
+DO NOT REMOVE THIS DATA SECTION.

t/Session/Id.t

@@ -53,7 +53,7 @@ my @testSets = (
 
 my $session = WebGUI::Test->session;
 
-plan tests => scalar(@testSets) + 5;
+plan tests => scalar(@testSets) + 6;
 
 # generate
 my $generateId = $session->id->generate();
@@ -79,6 +79,7 @@ foreach my $testSet (@testSets) {
 # 
 
 is($session->id->toHex('wjabZsKOb7kBBSiO3bQwzA'), 'c2369b66c28e6fb90105288eddb430cc', 'toHex works');
+is($session->id->fromHex('c2369b66c28e6fb90105288eddb430cc'), 'wjabZsKOb7kBBSiO3bQwzA', 'fromHex works');
 
 my $re = $session->id->getValidator;
 is( ref $re, 'Regexp', 'getValidator returns a regexp object');

t/Session/Url.t

@@ -52,7 +52,7 @@ my @getRefererUrlTests = (
 
 use Test::More;
 use Test::MockObject::Extends;
-plan tests => 72 + scalar(@getRefererUrlTests);
+plan tests => 76 + scalar(@getRefererUrlTests);
 
 my $session = WebGUI::Test->session;
 
@@ -284,6 +284,12 @@ is($session->url->makeAbsolute('page1'), '/page1', 'makeAbsolute: default baseUr
 my $origExtras = $session->config->get('extrasURL');
 my $extras  = $origExtras;
 
+my $savecdn = $session->config->get('cdn');
+if ($savecdn) {
+	$session->config->delete('cdn');
+}
+# Note: the CDN configuration will be reverted in the END
+
 is($session->url->extras, $extras.'/', 'extras method returns URL to extras with a trailing slash');
 is($session->url->extras('foo.html'), join('/', $extras,'foo.html'), 'extras method appends to the extras url');
 is($session->url->extras('/foo.html'), join('/', $extras,'foo.html'), 'extras method removes extra slashes');
@@ -301,8 +307,34 @@ $session->config->set('extrasURL', $extras);
 is($session->url->extras('/foo.html'),       join('', $extras,'foo.html'),      'extras method removes extra slashes');
 is($session->url->extras('/dir1//foo.html'), join('', $extras,'dir1/foo.html'), 'extras method removes extra slashes anywhere');
 
+$extras = 'http://mydomain.com/';
+$session->config->set('extrasURL', $extras);
+
+my $cdnCfg = { "enabled"   => 1,
+			   "extrasCdn"  => "http://extras.example.com/",
+			   "extrasSsl"  => "https://ssl.example.com/",
+			   "extrasExclude" => ["^tiny"]
+			 };
+$session->config->set('cdn', $cdnCfg);
+is($session->url->extras('/dir1/foo.html'), join('', $cdnCfg->{extrasCdn}, 'dir1/foo.html'),
+   'extras cleartext with CDN');
+is($session->url->extras('tinymce'), join('', $extras, 'tinymce'),
+   'extras exclusion from CDN');
+# Note: env is already mocked above.
+$mockEnv{HTTPS} = 'on';
+is($session->url->extras('/dir1/foo.html'), join('', $cdnCfg->{extrasSsl}, 'dir1/foo.html'),
+   'extras using extrasSsl with HTTPS');
+$mockEnv{HTTPS} = undef;
+$mockEnv{SSLPROXY} = 1;
+is($session->url->extras('/dir1/foo.html'), join('', $cdnCfg->{extrasSsl}, 'dir1/foo.html'),
+   'extras using extrasSsl with SSLPROXY');
+delete $mockEnv{SSLPROXY};
+
 $session->config->set('extrasURL', $origExtras);
 
+# partial cleanup here; complete cleanup in END block
+$session->config->delete('cdn');
+
 #######################################
 #
 # escape and unescape
@@ -468,4 +500,9 @@ END {  ##Always clean-up
 	else {
 		$session->config->delete('webServerPort');
 	}
+	if ($savecdn) {
+	   $session->config->set('cdn', $savecdn);
+	} else {
+	   $session->config->delete('cdn');
+	}
 }

t/Storage.t

@@ -29,7 +29,7 @@ my $cwd = Cwd::cwd();
 
 my ($extensionTests, $fileIconTests) = setupDataDrivenTests($session);
 
-my $numTests = 74; # increment this value for each test you create
+my $numTests = 102; # increment this value for each test you create
 plan tests => $numTests + scalar @{ $extensionTests } + scalar @{ $fileIconTests };
 
 my $uploadDir = $session->config->get('uploadsPath');
@@ -73,6 +73,12 @@ is( $storage1->getPathFrag, '7e/8a/7e8a1b6a', 'pathFrag returns correct value');
 #
 ####################################################
 
+my $savecdn = $session->config->get('cdn');
+if ($savecdn) {
+	$session->config->delete('cdn');
+}
+# Note: the CDN configuration will be reverted after CDN tests below
+
 my $storageDir1 = join '/', $uploadDir, '7e', '8a', '7e8a1b6a';
 is ($storage1->getPath, $storageDir1, 'getPath: path calculated correctly for directory');
 my $storageFile1 = join '/', $storageDir1, 'baz';
@@ -369,6 +375,118 @@ foreach my $iconTest (@{ $fileIconTests }) {
 	is( $storage1->getFileIconUrl($iconTest->{filename}), $iconTest->{iconUrl}, $iconTest->{comment} );
 }
 
+####################################################
+#
+# CDN (Content Delivery Network)
+#
+####################################################
+
+my $cdnCfg = { "enabled"   => 1,
+			   "url"       => "file:///data/storage",
+			   "queuePath" => "/data/cdnqueue",
+			   "syncProgram" => "cp -r -- '%s' /data/storage/",
+			   "deleteProgram" => "rm -r -- '/data/storage/%s' > /dev/null 2>&1"
+			 };
+my ($addedCdnQ, $addedCdnU);
+$addedCdnQ = mkdir $cdnCfg->{'queuePath'}  unless -e $cdnCfg->{'queuePath'};
+my $dest = substr($cdnCfg->{'url'}, 7);
+$addedCdnU = mkdir $dest  unless  -e $dest;
+$session->config->set('cdn', $cdnCfg);
+my $cdnUrl = $cdnCfg->{'url'};
+my $cdnUlen = length $cdnUrl;
+my $cdnStorage = WebGUI::Storage->create($session);
+# Functional URL before sync done
+my $hexId = $session->id->toHex($cdnStorage->getId);
+my $initUrl = join '/', $uploadUrl, $cdnStorage->getPathFrag;
+is ($cdnStorage->getUrl, $initUrl, 'CDN: getUrl: URL before sync');
+$filename = $cdnStorage->addFileFromScalar('cdnfile1', $content);
+is ($filename, 'cdnfile1', 'CDN: filename returned by addFileFromScalar');
+my $qFile = $cdnCfg->{'queuePath'} . '/' . $session->id->toHex($cdnStorage->getId);
+my $dotCdn = $cdnStorage->getPath . '/.cdn';
+ok (-e $qFile, 'CDN: queue file created when file added to storage');
+
+### getCdnFileIterator
+my $found = 0;
+my $sobj = undef;
+my $flist;
+my $cdnPath = substr($cdnUrl, 7) . '/' . $hexId;
+my $cdnFn = $cdnPath . '/' . $filename;
+my $locIter = WebGUI::Storage->getCdnFileIterator($session);
+my $already;  # test the object type only once
+if (is(ref($locIter), 'CODE', 'CDN: getCdnFileIterator to return sub ref')) {
+   while (my $sobj = $locIter->()) {
+	  unless ($already) {
+		 ok($sobj->isa('WebGUI::Storage'), 'CDN: iterator produces Storage objects');
+		 $already = 1;
+	  }
+	  if ($sobj->getId eq $cdnStorage->getId) {  # the one we want to test with
+		 ++$found;
+		 $flist = $sobj->getFiles;
+		 if (is(scalar @$flist, 1, 'CDN: there is one file in the storage')) {
+			my $file1 = $flist->[0];
+			is ($file1, $filename, 'CDN: correct filename in the storage');
+		 }
+	  }
+   }
+}
+is ($found, 1, 'CDN: getCdnFileIterator found storage');
+# TODO: I'm not sure how to make these run on MS-Windows.
+#       Should we SKIP in the meantime?   ($^O eq 'MSWin32')
+### syncToCdn
+$cdnStorage->syncToCdn;
+ok( (-e $cdnPath and -d $cdnPath), 'CDN: target directory created');
+ok( (-e $cdnFn and -T $cdnFn), 'CDN: target text file created');
+is (-s $cdnFn, length $content, 'CDN: file is the right size');
+ok (!(-e $qFile), 'CDN: queue file removed after sync');
+ok (-e $dotCdn, 'CDN: dot-cdn flag file present after sync');
+### getUrl with CDN
+my $locUrl = $cdnUrl . '/' . $session->id->toHex($cdnStorage->getId);
+is ($cdnStorage->getUrl, $locUrl, 'CDN: getUrl: URL for directory');
+my $fileUrl = $locUrl . '/' . 'cdn-file';
+is ($cdnStorage->getUrl('cdn-file'), $fileUrl, 'CDN: getUrl: URL for file');
+# SSL
+my %mockEnv = %ENV;
+my $env = Test::MockObject::Extends->new($session->env);
+$env->mock('get', sub { return $mockEnv{$_[1]} } );
+$mockEnv{HTTPS} = 'on';
+$cdnCfg->{'sslAlt'} = 1;
+$session->config->set('cdn', $cdnCfg);
+is ($cdnStorage->getUrl, $initUrl, 'CDN: getUrl: URL with sslAlt flag');
+$cdnCfg->{'sslUrl'} = 'https://ssl.example.com';
+$session->config->set('cdn', $cdnCfg);
+my $sslUrl = $cdnCfg->{'sslUrl'} . '/' . $session->id->toHex($cdnStorage->getId);
+is ($cdnStorage->getUrl, $sslUrl, 'CDN: getUrl: sslUrl');
+$mockEnv{HTTPS} = undef;
+is ($cdnStorage->getUrl, $locUrl, 'CDN: getUrl: cleartext request to not use sslUrl');
+# Copy
+my $cdnCopy = $cdnStorage->copy;
+my $qcp = $cdnCfg->{'queuePath'} . '/' . $session->id->toHex($cdnCopy->getId);
+ok (-e $qcp, 'CDN: queue file created when storage location copied');
+my $dotcp = $cdnCopy->getPath . '/.cdn';
+ok (!(-e $dotcp), 'CDN: dot-cdn flag file absent after copy');
+# On clear, need to see the entry in cdnQueue
+$qFile = $cdnCfg->{'queuePath'} . '/' . $session->id->toHex($cdnStorage->getId);
+$cdnStorage->clear;
+ok (-e $qFile, 'CDN: queue file created when storage cleared');
+ok (-s $qFile >= 7 && -s $qFile <= 9, 'CDN: queue file has right size for deleted (clear)');
+ok (!(-e $dotCdn), 'CDN: dot-cdn flag file absent after clear');
+### deleteFromCdn
+$cdnStorage->deleteFromCdn;
+ok(! (-e $cdnPath), 'CDN: target directory removed');
+ok(! (-e $qFile), 'CDN: queue file removed');
+# Idea: add a file back before testing delete
+# Note: expect it is necessary to be able to delete after clear.
+# On delete, need to see the entry in cdnQueue
+$cdnStorage->delete;
+ok (-e $qFile, 'CDN: queue file created when storage deleted');
+ok (-s $qFile >= 7 && -s $qFile <= 9, 'CDN: queue file has right size for deleted');
+$cdnStorage->deleteFromCdn;
+ok(! (-e $qFile), 'CDN: queue file removed');
+
+# partial cleanup here; complete cleanup in END block
+undef $cdnStorage;
+$session->config->delete('cdn');
+
 
 ####################################################
 #
@@ -452,8 +570,15 @@ END {
         $storage1,   $storage2, $storage3, $copiedStorage,
         $secondCopy, $s3copy,   $tempStor, $tarStorage,
         $untarStorage, $fileStore,
-        $hackedStore,
+        $hackedStore, $cdnStorage, $cdnCopy,
     ) {
 		ref $stor eq "WebGUI::Storage" and $stor->delete;
 	}
+	if ($savecdn) {
+	   $session->config->set('cdn', $savecdn);
+	} else {
+	   $session->config->delete('cdn');
+	}
+	$addedCdnQ  and  rmdir $addedCdnQ;
+	$addedCdnU  and  rmdir $addedCdnU;
 }