db_file_copy Bug fix

tcl/db_file.tcl

@@ -35,6 +35,11 @@ proc qc::db_file_insert {args} {
 proc qc::db_file_copy {file_id} {
     #| Make a copy of this file
     set new_file_id [db_seq file_id_seq]
+
+    qc::aws_credentials_set_from_ec2_role
+    set s3_location_from [qc::s3 uri [qc::param_get s3_file_bucket] $file_id]
+    set s3_location_to [qc::s3 uri [qc::param_get s3_file_bucket] $new_file_id]
+    qc::s3 copy $s3_location_from $s3_location_to
     db_dml {
         insert into file 
         (file_id,user_id,filename,data,mime_type,s3_location)
@@ -44,7 +49,7 @@ proc qc::db_file_copy {file_id} {
         filename,
         data,
         mime_type,
-        s3_location
+        :s3_location_to
         from file
         where file_id=:file_id
     }

test/db_file.test

@@ -30,6 +30,29 @@ test db_file_insert-1.0 {Upload a file to s3 and record the file info in the dat
     } \
     -result "Hello World"
 
+test db_file_copy-1.0 {Make a copy of a file on s3 and record the new file info in the database} \
+    -setup $setup \
+    -cleanup $cleanup \
+    -body {
+        set filepath [qc::file_temp "Hello World"]
+        file rename $filepath ${filepath}.txt
+        set filepath ${filepath}.txt
+
+        set file_id [qc::db_file_insert -user_id 0 $filepath]
+        file delete $filepath
+
+        set new_file_id [qc::db_file_copy $file_id]
+        set filepath [qc::db_file_export $new_file_id]
+        set result [qc::cat $filepath]
+        file delete $filepath
+
+        qc::db_file_delete $new_file_id
+        qc::db_file_delete $file_id
+
+        return $result        
+    } \
+    -result "Hello World"
+
 
 test db_file_migrate-1.0 {Migrate a file from data to S3} \
     -setup $setup \