chicken-hackers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Chicken-hackers] [PATCH] check egg names in setup-download


From: Felix
Subject: [Chicken-hackers] [PATCH] check egg names in setup-download
Date: Fri, 16 Mar 2012 08:44:55 +0100 (CET)

Hello!

Here a patch for setup-download that validates egg names, both passed
on the command-line and pulled in through .meta files.

Christian, can you review this?


cheers,
felix
>From d0273ec8610d1d18ff35515bbbfee51425298b5b Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 2 Mar 2012 12:02:35 +0100
Subject: [PATCH] check egg-name in setup-download

---
 setup-download.scm |   13 +++++++++++++
 1 files changed, 13 insertions(+), 0 deletions(-)

diff --git a/setup-download.scm b/setup-download.scm
index 9619d80..29ed6e7 100644
--- a/setup-download.scm
+++ b/setup-download.scm
@@ -417,10 +417,21 @@
                 (read-line in)
                 (get-chunks (cons chunk data)) ) ) ) ) ))
 
+  (define slashes (char-set #\\ #\/))
+
+  (define (valid-extension-name? name)
+    (and (not (member name '("" ".." ".")))
+        (not (string-index name slashes))))
+
+  (define (check-egg-name name)
+    (unless (valid-extension-name? name)
+      (error "invalid extension name" name)))
+
   (define (retrieve-extension name transport location
                               #!key version quiet destination username 
password tests
                              proxy-host proxy-port proxy-user-pass
                              trunk (mode 'default) clean)
+    (check-egg-name name)
     (fluid-let ((*quiet* quiet)
                (*trunk* trunk)
                (*mode* mode))
@@ -436,6 +447,7 @@
 
   (define (list-extensions transport location #!key quiet username password
                           proxy-host proxy-port proxy-user-pass)
+    (check-egg-name name)
     (fluid-let ((*quiet* quiet))
       (case transport
        ((local)
@@ -448,6 +460,7 @@
         (error "cannot list extensions - unsupported transport" transport) ) ) 
) )
 
   (define (list-extension-versions name transport location #!key quiet 
username password)
+    (check-egg-name name)
     (fluid-let ((*quiet* quiet))
       (case transport
        ((local)
-- 
1.6.0.4


reply via email to

[Prev in Thread] Current Thread [Next in Thread]