1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- A D A . D I R E C T O R I E S . V A L I D I T Y -- 6-- -- 7-- B o d y -- 8-- (Windows Version) -- 9-- -- 10-- Copyright (C) 2004-2012, Free Software Foundation, Inc. -- 11-- -- 12-- GNAT is free software; you can redistribute it and/or modify it under -- 13-- terms of the GNU General Public License as published by the Free Soft- -- 14-- ware Foundation; either version 3, or (at your option) any later ver- -- 15-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 16-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 17-- or FITNESS FOR A PARTICULAR PURPOSE. -- 18-- -- 19-- As a special exception under Section 7 of GPL version 3, you are granted -- 20-- additional permissions described in the GCC Runtime Library Exception, -- 21-- version 3.1, as published by the Free Software Foundation. -- 22-- -- 23-- You should have received a copy of the GNU General Public License and -- 24-- a copy of the GCC Runtime Library Exception along with this program; -- 25-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 26-- <http://www.gnu.org/licenses/>. -- 27-- -- 28-- GNAT was originally developed by the GNAT team at New York University. -- 29-- Extensive contributions were provided by Ada Core Technologies Inc. -- 30-- -- 31------------------------------------------------------------------------------ 32 33-- This is the Windows version of this package 34 35with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; 36 37package body Ada.Directories.Validity is 38 39 Invalid_Character : constant array (Character) of Boolean := 40 (NUL .. US | '\' => True, 41 '/' | ':' | '*' | '?' => True, 42 '"' | '<' | '>' | '|' => True, 43 DEL .. NBSP => True, 44 others => False); 45 46 --------------------------------- 47 -- Is_Path_Name_Case_Sensitive -- 48 --------------------------------- 49 50 function Is_Path_Name_Case_Sensitive return Boolean is 51 begin 52 return False; 53 end Is_Path_Name_Case_Sensitive; 54 55 ------------------------ 56 -- Is_Valid_Path_Name -- 57 ------------------------ 58 59 function Is_Valid_Path_Name (Name : String) return Boolean is 60 Start : Positive := Name'First; 61 Last : Natural; 62 63 begin 64 -- A path name cannot be empty, cannot contain more than 256 characters, 65 -- cannot contain invalid characters and each directory/file name need 66 -- to be valid. 67 68 if Name'Length = 0 or else Name'Length > 256 then 69 return False; 70 71 else 72 -- A drive letter may be specified at the beginning 73 74 if Name'Length >= 2 75 and then Name (Start + 1) = ':' 76 and then 77 (Name (Start) in 'A' .. 'Z' or else 78 Name (Start) in 'a' .. 'z') 79 then 80 Start := Start + 2; 81 82 -- A drive letter followed by a colon and followed by nothing or 83 -- by a relative path is an ambiguous path name on Windows, so we 84 -- don't accept it. 85 86 if Start > Name'Last 87 or else (Name (Start) /= '/' and then Name (Start) /= '\') 88 then 89 return False; 90 end if; 91 end if; 92 93 loop 94 -- Look for the start of the next directory or file name 95 96 while Start <= Name'Last and then 97 (Name (Start) = '\' or Name (Start) = '/') 98 loop 99 Start := Start + 1; 100 end loop; 101 102 -- If all directories/file names are OK, return True 103 104 exit when Start > Name'Last; 105 106 Last := Start; 107 108 -- Look for the end of the directory/file name 109 110 while Last < Name'Last loop 111 exit when Name (Last + 1) = '\' or Name (Last + 1) = '/'; 112 Last := Last + 1; 113 end loop; 114 115 -- Check if the directory/file name is valid 116 117 if not Is_Valid_Simple_Name (Name (Start .. Last)) then 118 return False; 119 end if; 120 121 -- Move to the next name 122 123 Start := Last + 1; 124 end loop; 125 end if; 126 127 -- If Name follows the rules, it is valid 128 129 return True; 130 end Is_Valid_Path_Name; 131 132 -------------------------- 133 -- Is_Valid_Simple_Name -- 134 -------------------------- 135 136 function Is_Valid_Simple_Name (Name : String) return Boolean is 137 Only_Spaces : Boolean; 138 139 begin 140 -- A file name cannot be empty, cannot contain more than 256 characters, 141 -- and cannot contain invalid characters. 142 143 if Name'Length = 0 or else Name'Length > 256 then 144 return False; 145 146 -- Name length is OK 147 148 else 149 Only_Spaces := True; 150 for J in Name'Range loop 151 if Invalid_Character (Name (J)) then 152 return False; 153 elsif Name (J) /= ' ' then 154 Only_Spaces := False; 155 end if; 156 end loop; 157 158 -- If no invalid chars, and not all spaces, file name is valid 159 160 return not Only_Spaces; 161 end if; 162 end Is_Valid_Simple_Name; 163 164 ------------- 165 -- OpenVMS -- 166 ------------- 167 168 function OpenVMS return Boolean is 169 begin 170 return False; 171 end OpenVMS; 172 173 ------------- 174 -- Windows -- 175 ------------- 176 177 function Windows return Boolean is 178 begin 179 return True; 180 end Windows; 181 182end Ada.Directories.Validity; 183