#!/usr/bin/perl use strict; use warnings; # Mirror files from a Transcend Wi-Fi SD Card to current directory # Copyright (C) Glen Pitt-Pladdy 2014 # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. # # # See: https://www.pitt-pladdy.com/blog/_20140202-083815_0000_Transcend_Wi-Fi_SD_Hacks_CF_adaptor_telnet_custom_upload_/ # my $PROXY; # proxy may be set manually, or set to '' to force no-proxy #$PROXY = 'http://someproxy.example.com:3128/'; my $USELOCALTIME = 0; # camera clock is set to local time rather than UTC my $TOLOWERCASE = 1; use LWP::UserAgent; use URI::Escape; use Date::Parse; use File::Path; # check args and work out host and directory if ( @ARGV != 1 ) { die "Usage: $0 [:PATH (default /DCIM/)]\n"; } my $pathspec = $ARGV[0]; my $host; my $dir = 'DCIM'; if ( $pathspec =~ /^(.*):\/(.*)$/ or $pathspec =~ /^(.*):(.*)$/ ) { ( $host, $dir ) = ( $1, $2 ); } elsif ( $pathspec !~ /\// ) { $host = $pathspec; } else { die "FATAL - invalid path specification \"$pathspec\"\n"; } # read in credentials # format: [alias] ... : my %credentials = ( '192.168.11.254' => [ 'admin', 'admin' ] ); my %aliases; if ( open ( my $fp, '<', "$ENV{HOME}/.wifisdMirrorHTTP.conf" ) ) { while ( defined ( my $line = <$fp> ) ) { chomp ( $line ); if ( $line =~ /^#/ or $line eq '' ) { next; } if ( $line =~ s/^([^\s]+)\s+// ) { my $host = $1; if ( $line !~ s/\s([^\s]+):([^\s]+)$// ) { $credentials{$host} = [ $1, $2 ]; } foreach (split /\s+/, $line ) { $aliases{$_} = $host; } } } close ( $fp ); } else { warn "WARNING - config file \"~/.wifisdMirrorHTTP.conf\" can't be read: $!\n"; } # set host based on aliases if ( exists ( $aliases{$host} ) ) { $host = $aliases{$host}; } # LWP HTTP agent my $ua = LWP::UserAgent->new; if ( defined ( $PROXY ) ) { if ( $PROXY ne '' ) { $ua->proxy ( ['http'], $PROXY ); } } else { # rely on environmnet $ua->env_proxy (); } $ua->agent ( 'Wi-Fi SD Mirror HTTP' ); if ( exists ( $credentials{$host} ) ) { $ua->credentials ( $host, '', $credentials{$host}->[1], $credentials{$host}->[2] ); } # get file list my @files; @files = getlistingrecursive ( $host, $dir ); #@files = getlisting ( $host, $dir ); if ( ! @files ) { die "FATAL - can't get file listing for host \"$host:/$dir\""; } # mirror these files my $timestart = time(); my $bytes = 0; foreach my $file (@files) { if ( $file->{Type} ne 'File' ) { next; } my $filedir = $dir; my $name = $file->{Name}; my $destination = $TOLOWERCASE?lc($name):$name; if ( $file->{Name} =~ /^(.*)\/([^\/]+)$/ ) { my $subdir; ( $subdir, $name ) = ( $1, $2 ); $filedir .= "/$subdir"; $filedir =~ s/^\///; $destination = "$subdir/".($TOLOWERCASE?lc($name):$name); if ( ! -d $subdir ) { mkpath ( $subdir ) or die "FATAL - can't create directory \"$subdir\": $!\n"; } } # work out directory and file part if ( -f $destination and -s $destination == $file->{'File size'} and (stat $destination)[9] == $file->{'Last file modification'} ) { next; } print "Get: $destination\n"; downloadfile ( $host, $filedir, $name, $destination, $file->{'Last file modification'}, $file->{'File size'} ) and $bytes += $file->{'File size'}; } if ( $bytes > 0 ) { my $elapsed = time () - $timestart; my $rate = $bytes / $elapsed; printf ( "Rate: %.01f KiB/s\n", $rate / 1024 ); } sub geturl { my ( $url ) = @_; my $request = new HTTP::Request ( 'GET' => $url ); $request->header ( 'Accept' => 'text/html' ); my $result = $ua->request ( $request ); if ( $result->is_success ) { #print $result->content."\n"; return \$result->content; } else { warn "ERROR - while getting $url (".$result->status_line.")\n"; return undef; } } sub getmetadata { my ( $host, $dir, $file, $metadataref ) = @_; $dir =~ s/^\/+//; $dir =~ s/\/+$//; my $url = "http://$host/cgi-bin/tscmd?CMD=GET_FILE_INFO&FILE=".uri_escape("/www/sd/$dir/$file"); my $content = geturl ( $url ); if ( ! defined ( $content ) ) { return undef; } my @lines = map { s/\r$//; $_ } split ( "\n", $$content ); foreach my $line (@lines) { if ( $line eq '' ) { next; } if ( $line !~ /^(\w[^:]*):\s*([^\s].*)$/ ) { warn "ERROR - invalid line \"$line\" in \"$url\"\n"; return undef; } my ( $field, $value ) = ( $1, $2 ); if ( $field eq 'File size' ) { $value =~ s/\s*bytes$//; } elsif ( $field eq 'Last status change' or $field eq 'Last file access' or $field eq 'Last file modification' ) { $value = str2time ( $USELOCALTIME?$value:"$value UTC" ); } $metadataref->{$field} = $value; } return $metadataref; } sub getlisting { my ( $host, $dir ) = @_; $dir =~ s/^\/+//; $dir =~ s/\/+$//; my $url = "http://$host/cgi-bin/tslist?PATH=".uri_escape("/www/sd/$dir"); my $content = geturl ( $url ); if ( ! defined ( $content ) ) { return undef; } my @lines = split ( "\n", $$content ); if ( $lines[0] ne 'TS list1' ) { return undef; } if ( $lines[1] ne "List Files = /www/sd/$dir" ) { return undef; } my @data = split ( '&', $lines[2] ); my $count; my @files; foreach my $entry (@data) { if ( $entry =~ /^FileName(\d+)=(.+)$/ ) { $files[$1]->{'Name'} = uri_unescape ( $2 ); } elsif ( $entry =~ /^FileType(\d+)=(.+)$/ ) { $files[$1]->{'Type'} = uri_unescape ( $2 ); } elsif ( $entry =~ /^FileCount=(\d+)$/ ) { $count = $1; } else { return undef; } } if ( ! defined ( $count ) or @files != $count ) { return undef; } for ( my $i = 0; $i <= $#files; ++$i ) { getmetadata ( $host, $dir, $files[$i]->{Name}, $files[$i] ); } return @files; } sub getlistingrecursive { my ( $host, $dir, $filesref, $subdir ) = @_; $dir =~ s/^\/+//; $dir =~ s/\/+$//; if ( ! defined ( $filesref ) ) { $filesref = []; } my @subfiles; if ( defined ( $subdir ) ) { @subfiles = getlisting ( $host, "$dir/$subdir" ); foreach (@subfiles) { $_->{Name} = "$subdir/$_->{Name}"; } } else { @subfiles = getlisting ( $host, $dir ); } # deal with sub directories foreach my $file (@subfiles) { push @$filesref, $file; if ( $file->{Type} eq 'Directory' ) { getlistingrecursive ( $host, $dir, $filesref, $file->{Name} ); } } # return list if we are origianl parent if ( ! defined ( $subdir ) ) { return @$filesref; } } sub downloadfile { my ( $host, $dir, $file, $destination, $time, $size ) = @_; my $url = "http://$host/cgi-bin/wifi_download?fn=".uri_escape($file)."&fd=".uri_escape("/www/sd/$dir"); my $content = geturl ( $url ); if ( ! defined ( $content ) ) { return undef; } my $fh; if ( ! open ( $fh, '>', "$destination.TMP" ) ) { warn "ERROR - can't write \"$destination.TMP\": $!\n"; return undef; } print $fh $$content; close ( $fh ); if ( -s "$destination.TMP" != $size ) { warn "ERROR - size mismatch (got ".(-s "$destination.TMP")." expecting $size \"$destination.TMP\"\n"; unlink ( "$destination.TMP" ); return undef; } utime ( $time, $time, "$destination.TMP" ); rename ( "$destination.TMP", $destination ); return ( -s $destination ) ; }